Integrate the TR and TR optimizer test suites.

collects/tests/typed-scheme/main.rkt

@@ -1,13 +1,12 @@
 #lang scheme/base
 
-(provide go go/text)
-
 (require rackunit rackunit/text-ui racket/file
          mzlib/etc scheme/port
          compiler/compiler
          scheme/match mzlib/compile
          "unit-tests/all-tests.ss"
-         "unit-tests/test-utils.ss")
+         "unit-tests/test-utils.ss"
+         "optimizer/run.rkt")
 
 (define (scheme-file? s)
   (regexp-match ".*[.](rkt|ss|scm)$" (path->string s)))
@@ -85,38 +84,6 @@
               (succ-tests)
               (fail-tests)))
 
-(define tests
-  (test-suite "Typed Scheme Tests"
-              unit-tests int-tests))
-
-(provide tests int-tests unit-tests)
-
-(define (go tests) (test/gui tests))
-(define (go/text tests) (run-tests tests 'verbose))
-
-(define (just-one p*)
-  (define-values (path p b) (split-path p*))
-  (define f
-    (if (equal? "fail/" (path->string path))
-        (lambda (p thnk)
-          (define-values (pred info) (exn-pred p))
-          (parameterize ([error-display-handler void])
-            (with-check-info
-             (['predicates info])
-             (check-exn pred thnk))))
-        (lambda (p thnk) (check-not-exn thnk))))
-  (test-suite 
-   (path->string p)
-   (f
-    (build-path path p)
-    (lambda ()
-      (parameterize ([read-accept-reader #t]
-                     [current-load-relative-directory
-                      (path->complete-path path)]
-                     [current-directory path]
-                     [current-output-port (open-output-nowhere)])
-        (dr p))))))
-
 (define (compile-benchmarks)
   (define (find dir)
     (for/list ([d (directory-list dir)]
@@ -126,7 +93,7 @@
   (define common (collection-path "tests" "racket" "benchmarks" "common" "typed"))
   (define (mk path)
     (make-test-suite (path->string path)
-                     (for/list ([p (find path)])                       
+                     (for/list ([p (find path)])
                        (parameterize ([current-load-relative-directory
                                        (path->complete-path path)]
                                       [current-directory path])
@@ -138,7 +105,38 @@
               (mk common)
               (delete-directory/files (build-path common "compiled"))))
 
-(provide go go/text just-one compile-benchmarks)
+
+(define (just-one p*)
+  (define-values (path p b) (split-path p*))
+  (define f
+    (let ([dir (path->string path)])
+      (cond [(equal? dir "fail/")
+             (lambda (p thnk)
+               (define-values (pred info) (exn-pred p))
+               (parameterize ([error-display-handler void])
+                 (with-check-info
+                  (['predicates info])
+                  (check-exn pred thnk))))]
+            [(equal? dir "succeed/")
+             (lambda (p thnk) (check-not-exn thnk))]
+            [(equal? dir "optimizer/tests/")
+             (lambda (p* thnk) (test-opt p))])))
+  (test-suite
+   (path->string p)
+   (f
+    (build-path path p)
+    (lambda ()
+      (parameterize ([read-accept-reader #t]
+                     [current-load-relative-directory
+                      (path->complete-path path)]
+                     [current-directory path]
+                     [current-output-port (open-output-nowhere)])
+        (dr p))))))
 
 
+(define (go tests) (test/gui tests))
+(define (go/text tests) (run-tests tests 'verbose))
 
+(provide go go/text just-one
+         int-tests unit-tests compile-benchmarks
+         optimization-tests)

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

@@ -2,9 +2,7 @@
 (require racket/runtime-path
          rackunit rackunit/text-ui)
 
-(provide optimization-tests)
-
-(define show-names? (make-parameter #f))
+(provide optimization-tests test-opt)
 
 (define (generate-log name dir flags)
   ;; some tests require other tests, so some fiddling is required
@@ -53,29 +51,7 @@
               #: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))))))
+      (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)]
-   ;; we optionally take a test name. if none is given, run everything (#f)
-   #:args maybe-test-to-run
-   (and (not (null? maybe-test-to-run))
-        (car maybe-test-to-run))))
-
-(void ; to suppress output of the return value
- (run-tests
-  (cond [single-test
-         (let-values ([(base name _) (split-path single-test)])
-           (make-test-suite "Single Test" (test-opt name)))]
-        [else ; default = run everything
-	 optimization-tests])
-  'normal))

collects/tests/typed-scheme/run.rkt

@@ -1,47 +1,39 @@
 #lang racket
-(require racket/vector racket/gui/dynamic)
+(require racket/vector racket/gui/dynamic rackunit)
 
 (require "main.ss")
 
 (define exec (make-parameter go/text))
-(define the-tests (make-parameter #f))
 (define nightly? (make-parameter #f))
 (define unit? (make-parameter #f))
 (define int? (make-parameter #f))
 (define opt? (make-parameter #f))
 (define bench? (make-parameter #f))
+(define single (make-parameter #f))
 (current-namespace (make-base-namespace))
 (command-line
  #:once-each
  ["--unit" "run the unit tests" (unit? #t)]
  ["--int" "run the integration tests" (int? #t)]
- ["--nightly" "for the nightly builds" (begin (nightly? #t) (unit? #t) (int? #t))]
- ["--just" path "run only this test" (the-tests (just-one path))]
- ["--opt" "run the optimizer tests" (opt? #t)]
+ ["--opt" "run the optimization tests" (opt? #t)]
  ["--benchmarks" "compile the typed benchmarks" (bench? #t)]
+ ["--just" path "run only this test" (single (just-one path))]
+ ["--nightly" "for the nightly builds" (begin (nightly? #t) (unit? #t) (int? #t) (opt? #t))]
  ["--all" "run all tests" (begin (unit? #t) (int? #t) (opt? #t) (bench? #t))]
  ["--gui" "run using the gui" 
           (if (gui-available?)
               (begin (exec go))
-              (error "GUI not available"))]
- )
+              (error "GUI not available"))])
 
-(the-tests
- (cond [(and (unit?) (int?)) tests]
-       [(unit?)              unit-tests]
-       [(int?)               int-tests]
-       [(or (the-tests) (bench?) (opt?)) (the-tests)]
-       [else
-        (error "You must specify which tests should be run. See --help for more info.\n")]))
-
-(cond [(and (nightly?) (eq? 'cgc (system-type 'gc)))
-       (printf "Skipping Typed Racket tests.\n")]
-      [(when (the-tests)
-         (unless (= 0 ((exec) (the-tests)))
-           (eprintf "Typed Racket Tests did not pass.\n")))
-       (when (opt?)
-         (parameterize ([current-command-line-arguments #()])
-           (dynamic-require '(file "optimizer/run.rkt") #f)))
-       (when (bench?)
-         (unless (= 0 ((exec) (compile-benchmarks)))
-           (error "Typed Racket Tests did not pass.\n")))])
+(if (and (nightly?) (eq? 'cgc (system-type 'gc)))
+    (printf "Skipping Typed Racket tests.\n")
+    (let ([to-run (cond [(single) (single)]
+                        [else
+                         (make-test-suite
+                          "Typed Racket Tests"
+                          (append (if (unit?)        (list unit-tests)           '())
+                                  (if (int?)         (list int-tests)            '())
+                                  (if (opt?)         (list optimization-tests)   '())
+                                  (if (bench?)       (list (compile-benchmarks)) '())))])])
+      (unless (= 0 ((exec) to-run))
+        (eprintf "Typed Racket Tests did not pass.\n"))))