From e2b1e94f707ac0ea8dbbd4aa51bf11107fb11597 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 27 Jul 2020 01:06:06 +0200 Subject: Improve opt parsing in test runner. --- tests/run-tests.scm | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/tests/run-tests.scm b/tests/run-tests.scm index 6d9b3ac0..d2b86828 100755 --- a/tests/run-tests.scm +++ b/tests/run-tests.scm @@ -14,6 +14,7 @@ (use-modules (ice-9 ftw) (ice-9 sandbox) + (ice-9 getopt-long) (srfi srfi-64) ; test suite (srfi srfi-88) ; suffix keywords ((util) :select (for awhen)) @@ -40,15 +41,26 @@ (loop (cons sexp done)))))) +(define options + '((skip (value #t)) + (only (value #t)))) + +(define opts (getopt-long (command-line) options)) +(define to-skip (call-with-input-string (option-ref opts 'skip "") + read)) +(define only (option-ref opts 'only #f)) + +(when only (set! files (list only))) + +(when (list? to-skip) + (for skip in to-skip + (test-skip skip))) + ;; TODO test-group fails if called before any test begin, since ;; (test-runner-current) needs to be a test-runner (dead or not), ;; but is initially bound to #f. (test-begin "tests") -(awhen (member "--skip" (command-line)) - (for skip in (cdr it) - (test-skip skip))) - (for fname in files (format (current-error-port) "Running test ~a~%" fname) (test-group @@ -70,7 +82,7 @@ ) all-pure-bindings))))))) (lambda args (format (current-error-port) - "Test really crashed: ~a~%" args) )))) + "Test unexpectedly crashed: ~a~%" args) )))) (test-end "tests") -- cgit v1.2.3