Make sure the test results are displayed, even when an exception

occurs running the tests.

svn: r15724

collects/lang/run-teaching-program.ss

@@ -59,7 +59,7 @@
                             ,@(map (λ (x) `(require ,x)) teachpacks)
                             ,@body-exps
                             ,@(if enable-testing?
-                                  (if (null? body-exps) '() `((,#'run-tests) (,#'display-results)))
+                                  (if (null? body-exps) '() `((,#'test)))
                                   '()))))
               rep)))]
         [(require)

collects/test-engine/scheme-gui.ss

@@ -1,7 +1,8 @@
 (module scheme-gui scheme/base
   
   (require mred framework scheme/class 
-           mzlib/pconvert mzlib/pretty)
+           mzlib/pconvert mzlib/pretty
+	   (for-syntax scheme/base))
   
   (require (except-in "scheme-tests.ss" test) "test-display.scm")
   
@@ -32,8 +33,13 @@
            text-snip))]
       [else (format "~v" value)]))
   
-  (define (test) (run-tests) (pop-up))
-  
+  (define-syntax (test stx) 
+    (syntax-case stx ()
+      [(_)
+       (syntax-property
+	#'(begin (run-tests) (pop-up))
+	'test-call #t)]))
+
   (define (pop-up)
     (let ([test-info (namespace-variable-value 'test~object #f builder (current-namespace))])
       (parameterize ([test-format format-value])

collects/test-engine/scheme-tests.ss

@@ -225,7 +225,15 @@
     (namespace-set-variable-value! 'test~object te (current-namespace))
     te))
 
-(define (test) (run-tests) (display-results))
+(define-syntax (test stx) 
+  (syntax-case stx ()
+    [(_)
+     (syntax-property
+      #'(dynamic-wind
+	    values
+	    (lambda () (run-tests))
+	    (lambda () (display-results)))
+      'test-call #t)]))
 
 (define-syntax (run-tests stx)
   (syntax-case stx ()