From a6bf6a1518781479c580263d03b0d15dd841f470 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 21 Apr 2017 16:48:03 -0700 Subject: [PATCH] Support TEST environment variable in "make check". Also clean up output slightly. --- tests/check.scm | 39 +++++++++++++++++++++++++++++++-------- 1 file changed, 31 insertions(+), 8 deletions(-) diff --git a/tests/check.scm b/tests/check.scm index 815c365a2..22e57e7f9 100644 --- a/tests/check.scm +++ b/tests/check.scm @@ -102,7 +102,7 @@ USA. (with-working-directory-pathname (directory-pathname pathname) (lambda () - ;++ Kludge around a bug in SF... + ;;++ Kludge around a bug in SF... (compile-file (file-pathname pathname) '() environment)))) @@ -114,11 +114,23 @@ USA. pathname))) (cons pathname (run-unit-tests p environment))))))) - known-tests))) + (let ((test-name (get-environment-variable "TEST"))) + (if test-name + (let ((e + (find (lambda (e) + (string=? test-name + (if (pair? e) (car e) e))) + known-tests))) + (if e + (list e) + (begin + (warn "Unknown test name:" test-name) + '()))) + known-tests))))) - (define (show-results results) + (define (show-results results tag) (for-each (lambda (p) - (write-string (if (cdr p) "PASSED" "FAILED")) + (write-string tag) (write-string ": ") (write (car p)) (newline)) @@ -126,7 +138,18 @@ USA. (fresh-line) (newline) - (write-string "Test results:") - (newline) - (show-results (filter cdr results)) - (show-results (remove cdr results))))) \ No newline at end of file + (let ((passed (filter cdr results)) + (failed (remove cdr results))) + (if (or (pair? passed) + (pair? failed)) + (begin + (write-string "Test results:") + (newline) + (show-results passed "PASSED") + (if (and (pair? passed) + (pair? failed)) + (newline)) + (show-results failed "FAILED")) + (begin + (write-string "No tests run") + (newline))))))) \ No newline at end of file -- 2.25.1