Make optimizer tests worker better with failures.

original commit: 418ecc87e08d0164f12e1264a39d8d2fcca635e6

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/run.rkt

@@ -11,19 +11,21 @@
 ;; we log optimizations and compare to an expected log to make sure that all
 ;; the optimizations we expected did indeed happen
 (define (compare-logs name dir)
-  (test-suite "Log Comparison"
-              ;; ugly, but otherwise rackunit spews the entire logs to
-              ;; stderr, and they can be quite long
-              (check-equal?
-               ;; actual log
-               (with-input-from-string
-                   (string-append "(" (generate-log name dir) ")")
-                 read)
-               ;; expected log
-               (with-input-from-file (build-path dir name)
-                 (lambda () ; from the test file
-                   (read-line) ; skip the #;
-                   (read))))))
+  (test-suite
+    (format "Log Comparison for ~a" name)
+    (test-begin
+      ;; ugly, but otherwise rackunit spews the entire logs to
+      ;; stderr, and they can be quite long
+      (check-equal?
+       ;; actual log
+       (with-input-from-string
+           (string-append "(" (generate-log name dir) ")")
+         read)
+       ;; expected log
+       (with-input-from-file (build-path dir name)
+         (lambda () ; from the test file
+           (read-line) ; skip the #;
+           (read)))))))
 
 
 (define-runtime-path tests-dir                "./tests")
@@ -31,9 +33,9 @@
 
 ;; these two return lists of tests to be run for that category of tests
 (define (test-opt name)
-  (list (compare-logs name tests-dir)))
+  (compare-logs name tests-dir))
 (define (test-missed-optimization name)
-  (list (compare-logs name missed-optimizations-dir)))
+  (compare-logs name missed-optimizations-dir))
 
 (define (test-file? name)
   (and (regexp-match ".*rkt$" name)
@@ -42,15 +44,11 @@
 
 ;; proc returns the list of tests to be run on each file
 (define (mk-suite suite-name dir proc)
-  (define prms (for/list ([name (directory-list dir)]
-                          #:when (test-file? name))
-                 (list name (delay/thread (proc name)))))
   (make-test-suite
-   suite-name
-   (for/list ([p prms])
-     (make-test-suite
-      (path->string (first p))
-      (force (second p))))))
+    suite-name
+    (for/list ([name (directory-list dir)]
+               #:when (test-file? name))
+      (proc name))))
 
 (define (optimization-tests)
   (mk-suite "Optimization Tests" tests-dir test-opt))

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/places.rkt

@@ -46,9 +46,7 @@
         [(vector 'log name dir res)
          (dynamic-require 'typed-racket/core #f)
          (with-handlers ([exn:fail? 
-                          (λ (e) (place-channel-put 
-                                  res 
-                                  (string-append "EXCEPTION: " (exn-message e))))])
+                          (λ (e) (place-channel-put res (serialize-exn e)))])
            (define lg (generate-log/place name dir))
            (place-channel-put res lg))
          (loop)]

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/send-places.rkt

@@ -26,6 +26,9 @@
   (cond [(places) 
          (define-values (res-ch res-ch*) (place-channel))
          (place-channel-put enq-ch (vector 'log name dir res-ch*))
-         (place-channel-get res-ch)]
+         (define res (place-channel-get res-ch))
+         (if (s-exn? res)
+             (raise (deserialize-exn res))
+             res)]
         [else
          (generate-log/place name dir)]))