diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/run.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/run.rkt index 23a1a1b61d..3c70bd2a9f 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/run.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/run.rkt @@ -8,19 +8,22 @@ test-opt test-missed-optimization test-file? generate-log tests-dir missed-optimizations-dir) +(define (get-expected-results file) + (with-input-from-file file + (lambda () ; from the test file + (read-line) ; skip the #;#; + (values (for/list ((l (in-lines (open-input-string (read))))) l) + (read))))) + ;; 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) +(define (compare-logs name dir promised-logs) (test-suite (format "Log Comparison for ~a" name) (test-begin - (define-values (log output) (generate-log name dir)) + (define-values (log output) (force promised-logs)) (define-values (expected-log expected-output) - (with-input-from-file (build-path dir name) - (lambda () ; from the test file - (read-line) ; skip the #;#; - (values (for/list ((l (in-lines (open-input-string (read))))) l) - (read))))) + (get-expected-results (build-path dir name))) (check-equal? log expected-log) (check-equal? output expected-output)))) @@ -30,10 +33,10 @@ (define-runtime-path missed-optimizations-dir "./missed-optimizations") ;; these two return lists of tests to be run for that category of tests -(define (test-opt name) - (compare-logs name tests-dir)) -(define (test-missed-optimization name) - (compare-logs name missed-optimizations-dir)) +(define (test-opt name logs) + (compare-logs name tests-dir logs)) +(define (test-missed-optimization name logs) + (compare-logs name missed-optimizations-dir logs)) (define (test-file? name) (and (regexp-match ".*rkt$" name) @@ -42,11 +45,13 @@ ;; 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 (test-file? name)) - (proc name)))) + (test-suite suite-name + (let* ((logs (for/hash ([name (directory-list dir)] + #:when (test-file? name)) + (values name (delay/thread (generate-log name dir)))))) + (make-test-suite "" + (for/list (((name logs) logs)) + (proc name logs)))))) (define (optimization-tests) (mk-suite "Optimization Tests" tests-dir test-opt))