Rewrite the optimizer test suite to use rackunit.

collects/tests/typed-scheme/optimizer/run.rkt

@@ -1,5 +1,6 @@
 #lang racket
-(require racket/runtime-path racket/sandbox)
+(require racket/runtime-path racket/sandbox
+         rackunit rackunit/text-ui)
 
 (define show-names? (make-parameter #f))
 
@@ -36,9 +37,10 @@
          (kill-evaluator evaluator)
          out)))))
 
-(define (generate-opt-log name)
+(define (generate-log name dir flags)
-  (parameterize ([current-load-relative-directory tests-dir]
+  ;; some tests require other tests, so some fiddling is required
-                 [current-command-line-arguments  '#("--log-optimizations")])
+  (parameterize ([current-load-relative-directory dir]
+                 [current-command-line-arguments  flags])
     (let ((log-string
            (with-output-to-string
              (lambda ()
@@ -50,31 +52,54 @@
       (with-input-from-string (string-append "(" log-string ")")
         read))))
 
-(define (test gen)
+(define (compare-logs name dir flags)
-  (let-values (((base name _) (split-path gen)))
+  (test-suite "Log Comparison"
-    (or (not (regexp-match ".*rkt$" name)) ; we ignore all but racket files
+              (check-equal?
-        (begin
+               ;; ugly, but otherwise rackunit spews the entire logs to
-          (when (show-names?) (displayln name))
+               ;; stderr, and they can be quite long
-          ;; we log optimizations and compare to an expected log to make sure
+               #t
-          ;; that all the optimizations we expected did indeed happen
+               (equal?
-          (and (or (let ((log      (generate-opt-log name))
+                ;; actual log
-                         ;; expected optimizer log, to see what was optimized
+                (generate-log name dir flags)
-                         (expected
+                ;; expected log
-                          (with-input-from-file gen
+                (with-input-from-file (build-path dir name)
-                            (lambda ()
+                  (lambda () ; from the test file
-                              (read-line) ; skip the #;
+                    (read-line) ; skip the #;
-                              (read)))))  ; get the log itself
+                    (read)))))))
-                     (equal? log expected))
-                   (begin
-                     (printf "~a failed: optimization log mismatch\n\n" name)
-                     #f))
-               ;; optimized and non-optimized versions must evaluate to the
-               ;; same thing
-               (or (equal? (evaluator gen) (evaluator gen #:optimize #t))
-                   (begin (printf "~a failed: result mismatch\n\n" name)
-                          #f)))))))
 
-(define to-run
+
+(define-runtime-path tests-dir       "./tests")
+
+;; these two return lists of tests to be run for that category of tests
+(define (test-opt name)
+  (let ([path (build-path tests-dir name)])
+    ;; we log optimizations and compare to an expected log to make sure that
+    ;; all the optimizations we expected did indeed happen
+    (list (compare-logs name tests-dir '#("--log-optimizations"))
+          (test-suite
+           ;; optimized and non-optimized versions must give the same result
+           "Result Comparison"
+           (check-equal? (evaluator path #:optimize #t)
+                         (evaluator path))))))
+
+;; proc returns the list of tests to be run on each file
+(define (mk-suite suite-name dir proc)
+  (make-test-suite
+   suite-name
+   (for/list ([name (directory-list dir)]
+              #:when (regexp-match ".*rkt$" name))
+     (make-test-suite
+      (path->string name)
+      (cons (test-suite
+             "Show Name"
+             (check-eq? (begin (when (show-names?) (displayln name)) #t) #t))
+            (proc name))))))
+
+(define optimization-tests
+  (mk-suite "Optimization Tests" tests-dir test-opt))
+
+
+(define single-test
   (command-line
    #:once-each
    ["--show-names" "show the names of tests as they are run" (show-names? #t)]
@@ -83,14 +108,11 @@
    (and (not (null? maybe-test-to-run))
         (car maybe-test-to-run))))
 
-(define-runtime-path tests-dir "./tests")
+(void ; to suppress output of the return value
-
+ (run-tests
-(let ((n-failures
+  (cond [single-test
-       (if to-run
+         (let-values ([(base name _) (split-path single-test)])
-           (if (test to-run) 0 1)
+           (make-test-suite "Single Test" (test-opt name)))]
-           (for/fold ((n-failures 0))
+        [else ; default = run everything
-             ((gen (in-directory tests-dir)))
+	 optimization-tests])
-             (+ n-failures (if (test gen) 0 1))))))
+  'normal))
-  (if (= n-failures 0)
-      (displayln "Typed Racket Optimizer tests passed.")
-      (printf "~a Typed Racket Optimizer tests failed." n-failures)))