Summarize test results at end of run.

diff --git a/tests/check.scm b/tests/check.scm
index 2595ff50f07e0b4c4ddfe4e297f00417dae57a62..2518aa98e1829e3d99677eb63ee759714321c82a 100644 (file)
--- a/tests/check.scm
+++ b/tests/check.scm
@@ -78,36 +78,53 @@ USA.
     (directory-pathname (current-load-pathname))
   (lambda ()
     (load "load")
-    (for-each (lambda (entry)
-                (receive (pathname environment)
-                         (if (pair? entry)
-                             (values (car entry) (->environment (cadr entry)))
-                             (values entry #!default))
-                  (with-notification
-                      (lambda (output-port)
-                        (write-string "Running tests in " output-port)
-                        (write pathname output-port)
-                        (if (not (default-object? environment))
-                            (begin
-                              (write-string " in environment " output-port)
-                              (write (cond ((environment->package environment)
-                                            => package/name)
-                                           (else environment))
-                                     output-port))))
-                    (lambda ()
-                      (if (not (pathname-type pathname))
-                          (with-working-directory-pathname
-                              (directory-pathname pathname)
-                            (lambda ()
-                              ;++ Kludge around a bug in SF...
-                              (compile-file (file-pathname pathname)
-                                            '()
-                                            environment))))
-                      (let* ((t (pathname-type pathname))
-                             (p (if (and t (string=? "com" t)
-                                         (eq? 'C
-                                              microcode-id/compiled-code-type))
-                                    (pathname-new-type pathname "so")
-                                    pathname)))
-                        (run-unit-tests p environment))))))
-              known-tests)))
\ No newline at end of file
+    (let ((results
+          (map (lambda (entry)
+                 (receive (pathname environment)
+                     (if (pair? entry)
+                         (values (car entry) (->environment (cadr entry)))
+                         (values entry #!default))
+                   (with-notification
+                    (lambda (output-port)
+                      (write-string "Running tests in " output-port)
+                      (write pathname output-port)
+                      (if (not (default-object? environment))
+                          (begin
+                            (write-string " in environment " output-port)
+                            (write (cond ((environment->package environment)
+                                          => package/name)
+                                         (else environment))
+                                   output-port))))
+                    (lambda ()
+                      (if (not (pathname-type pathname))
+                          (with-working-directory-pathname
+                           (directory-pathname pathname)
+                           (lambda ()
+                                              ;++ Kludge around a bug in SF...
+                             (compile-file (file-pathname pathname)
+                                           '()
+                                           environment))))
+                      (let* ((t (pathname-type pathname))
+                             (p (if (and t (string=? "com" t)
+                                         (eq? 'C
+                                              microcode-id/compiled-code-type))
+                                    (pathname-new-type pathname "so")
+                                    pathname)))
+                        (cons pathname
+                              (run-unit-tests p environment)))))))
+               known-tests)))
+
+      (define (show-results results)
+       (for-each (lambda (p)
+                   (write-string (if (cdr p) "PASSED" "FAILED"))
+                   (write-string ": ")
+                   (write (car p))
+                   (newline))
+                 results))
+
+      (fresh-line)
+      (newline)
+      (write-string "Test results:")
+      (newline)
+      (show-results (filter cdr results))
+      (show-results (remove cdr results)))))
\ No newline at end of file