From 566aeedb598dbc2788ff4360bb23177fbdd74a30 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 13 Jul 2010 17:35:44 -0400
Subject: [PATCH] Better error reporting by the optimizer's test harness.

---
 collects/tests/typed-scheme/optimizer/run.rkt | 32 ++++++++++---------
 1 file changed, 17 insertions(+), 15 deletions(-)

diff --git a/collects/tests/typed-scheme/optimizer/run.rkt b/collects/tests/typed-scheme/optimizer/run.rkt
index 4e8a6a2ebc..63cb7f8fd9 100644
--- a/collects/tests/typed-scheme/optimizer/run.rkt
+++ b/collects/tests/typed-scheme/optimizer/run.rkt
@@ -28,23 +28,25 @@
     (or (regexp-match ".*~" name) ; we ignore backup files
         ;; machine optimized and hand optimized versions must expand to the
         ;; same code
-        (and (equal? (parameterize ([current-load-relative-directory
-                                     (build-path here "generic")])
-                       (read-and-expand gen))
-                     (let ((hand-opt-dir (build-path here "hand-optimized")))
-                       (parameterize ([current-load-relative-directory hand-opt-dir])
-                         (read-and-expand (build-path hand-opt-dir name)))))
+        (and (or (equal? (parameterize ([current-load-relative-directory
+                                         (build-path here "generic")])
+                           (read-and-expand gen))
+                         (let ((hand-opt-dir (build-path here "hand-optimized")))
+                           (parameterize ([current-load-relative-directory hand-opt-dir])
+                             (read-and-expand (build-path hand-opt-dir name)))))
+                 (begin (printf "~a failed: expanded code mismatch\n\n" name)
+                        #f))
              ;; optimized and non-optimized versions must evaluate to the
              ;; same thing
-             (equal? (with-output-to-string
-                       (lambda ()
-                         (dynamic-require gen #f)))
-                     (with-output-to-string
-                       (lambda ()
-                         (let ((non-opt-dir (build-path here "non-optimized")))
-                           (dynamic-require (build-path non-opt-dir name) #f))))))
-        (begin (printf "~a failed\n\n" name)
-               #f))))
+             (or (equal? (with-output-to-string
+                           (lambda ()
+                             (dynamic-require gen #f)))
+                         (with-output-to-string
+                           (lambda ()
+                             (let ((non-opt-dir (build-path here "non-optimized")))
+                               (dynamic-require (build-path non-opt-dir name) #f)))))
+                 (begin (printf "~a failed: result mismatch\n\n" name)
+                        #f))))))
 
 (define-runtime-path here ".")