From ccd198d735b92979bbb0f746685c5dc71bd4c4d7 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sat, 5 Dec 1998 22:29:07 +0000
Subject: [PATCH] ...

original commit: 96d5cfa04a0e5d45385ce705e38e1dcbfdc0de99
---
 collects/tests/framework/README  |  2 +-
 collects/tests/framework/main.ss | 15 ++++++++++++---
 2 files changed, 13 insertions(+), 4 deletions(-)

diff --git a/collects/tests/framework/README b/collects/tests/framework/README
index 269eb015..aadae786 100644
--- a/collects/tests/framework/README
+++ b/collects/tests/framework/README
@@ -67,7 +67,7 @@ tests.
 
   | This tests the seaching frame.
 
-- info: |# info.ss #|
+- info: |# info-frame.ss #|
 
   | This tests the info frame. (ie that toolbar on the bottom of the
                                 screen)
diff --git a/collects/tests/framework/main.ss b/collects/tests/framework/main.ss
index f66c6404..57de592a 100644
--- a/collects/tests/framework/main.ss
+++ b/collects/tests/framework/main.ss
@@ -18,7 +18,8 @@
 
 (define-signature internal-TestSuite^
   ((open TestSuite^)
-   test-name))
+   test-name
+   failed-tests))
 
 (define-signature Engine^
   (only-these-tests
@@ -34,6 +35,7 @@
 	    mzlib:function^)
 
     (define test-name "<<setup>>")
+    (define failed-tests null)
 
     (define-struct eof-result ())
 
@@ -175,6 +177,7 @@
 		       (not (passed? result))))])
 	      (when failed
 		(printf "FAILED ~a: ~a~n" failed test-name)
+		(set! failed-tests (cons (cons section-name test-name) failed-tests))
 		(case jump
 		  [(section) (section-jump)]
 		  [(continue) (void)]
@@ -250,7 +253,7 @@
 				    [section-jump k])
 			  (with-handlers ([(lambda (x) #t)
 					   (lambda (exn)
-					     (printf "~a" (if (exn? exn) (exn-message exn) exn)))])
+					     (printf "~a~n" (if (exn? exn) (exn-message exn) exn)))])
 			    (printf "beginning ~a test suite~n" x)
 			    (invoke-unit/sig
 			     (eval
@@ -278,7 +281,13 @@
       (delete-file old-preferences-file))
     (printf "  restored preferences file~n")
 
-    (shutdown-listener)))
+    (shutdown-listener)
+
+    (unless (null? failed-tests)
+      (printf "FAILED tests:~n")
+      (for-each (lambda (failed-test)
+		  (printf "  ~a // ~a~n" (car failed-test) (cdr failed-test)))
+		failed-tests))))
 
 (invoke-unit/sig
  (compound-unit/sig