2 Commits

Author SHA1 Message Date
878d415e22 add command line options to sextest
Some checks failed
Sex CI / build-linux (pull_request) Has been cancelled
Sex CI / build-macos (pull_request) Has been cancelled
Sex CI / build-linux (push) Has been cancelled
Sex CI / build-macos (push) Has been cancelled
2026-05-21 20:22:06 +03:00
c678df7978 add sextest test runner
A tool for testing Sex programs. Details in tools/sextest/README.org
2026-05-21 20:15:03 +03:00
2 changed files with 57 additions and 28 deletions

View File

@@ -1,6 +1,6 @@
(input "Sextest") (input "Sextest")
(output "Hello from Sex!" "What is your name?" "Hello, Sextest!") (output "Hello from Sex!" "What is your name?" "Hello, Sextest!")
(return 252) (return 255)
(include stdio.h) (include stdio.h)

View File

@@ -10,6 +10,7 @@
(chicken read-syntax) (chicken read-syntax)
(chicken syntax) (chicken syntax)
fmt fmt
getopt-long
srfi-1) srfi-1)
(define-syntax prog1 (define-syntax prog1
@@ -73,7 +74,9 @@
(read-forms (cons r acc))))) (read-forms (cons r acc)))))
(define (print-help) (define (print-help)
(fmt #t "Usage: sextest ./path/to/test-file.sex\n")) (fmt #t "Usage: sextest [options] filename" nl
"Options:" nl
(usage opts-grammar) nl))
(define (process-file target-path) (define (process-file target-path)
(let ((contents (read-raw-forms target-path))) (let ((contents (read-raw-forms target-path)))
@@ -90,10 +93,10 @@
(cons (list) (list)) (cons (list) (list))
contents))) contents)))
(define (compile src flags) (define (compile src flags sexc)
(let ((compiler (or (get-environment-variable "SEXC") (let ((compiler (or
;; TODO: pass compiler in args (and sexc (cdr sexc))
;; (get-arg args 'sex-compiler #f) (get-environment-variable "SEXC")
"sexc")) "sexc"))
(compiled-file (create-temporary-file))) (compiled-file (create-temporary-file)))
(call-with-values (call-with-values
@@ -152,27 +155,53 @@
#f) #f)
#t)))))) #t))))))
(define (main) (define opts-grammar
(let ((args (command-line-arguments))) `((sexc ,(fmt #f "Path to sexc compiler. Defaults to value of SEXC" nl
(if (not (= 1 (length args))) (pad 26) "environment variable, ot if it's empty, to sexc" nl )
(print-help) (required #f)
(let ((settings-and-src (value #t))
(process-file (first args)))) (help "Show this help"
(let ((settings (car settings-and-src)) (required #f)
(src (cdr settings-and-src))) (value #f)
(let ((compiled-file (compile src (assoc 'compile settings)))) (single-char #\h))))
(unless compiled-file
(fmt #t "Compilation failed." nl) (define (process-test-file sexc path)
(exit 1)) (let* ((settings-and-src (process-file path))
(settings (car settings-and-src))
(src (cdr settings-and-src))
(compiled-file (compile src (assoc 'compile settings) sexc)))
(if (not compiled-file)
(begin (fmt #t "Failed to compile " path nl)
#f)
(if (run-and-check (if (run-and-check
compiled-file compiled-file
(assoc 'input settings) (assoc 'input settings)
(assoc 'output settings) (assoc 'output settings)
(assoc 'return settings)) (assoc 'return settings))
(fmt #t "PASS" nl) (begin (fmt #t ".")
(begin #t)
(fmt #t "FAIL" nl) (begin (fmt #t ",")
(exit 2))) #f)))))
(exit 0)))))))
(define (main)
(let ((args (getopt-long (command-line-arguments)
opts-grammar)))
(when (assoc 'help args)
(print-help)
(exit 0))
(when (null? (cdr (assoc '@ args)))
(fmt #t "Missing target file" nl)
(print-help)
(exit 1))
(unless
(foldl and
#t
(map (fn (process-test-file (assoc 'sexc args) x))
(cdr (assoc '@ args))))
;; TODO: add more verbose and human readable output and reporting
(fmt #t nl)
(exit 2))
(fmt #t nl)
(exit 0)))
(main) (main)