From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 21 Apr 2017 23:48:03 +0000 (-0700)
Subject: Support TEST environment variable in "make check".
X-Git-Tag: mit-scheme-pucked-9.2.12~158^2~20
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a6bf6a1518781479c580263d03b0d15dd841f470;p=mit-scheme.git

Support TEST environment variable in "make check".

Also clean up output slightly.
---

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