suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add flags for running the optimizer tests and compiling the benchmarks

Browse Source 
original commit: e989631d56a70b90077cbdca7993a25dc70c2011
This commit is contained in:
Sam Tobin-Hochstadt 2010-07-02 18:53:25 -04:00
parent b415e84cd6
commit 474741601b
3 changed files with 43 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/tests/typed-scheme/main.rkt
View File

@ -5,12 +5,12 @@
(require rackunit rackunit/text-ui
mzlib/etc scheme/port
compiler/compiler
scheme/match
scheme/match mzlib/compile
"unit-tests/all-tests.ss"
"unit-tests/test-utils.ss")
(define (scheme-file? s)
(regexp-match ".*[.](rkt|ss|scm)" (path->string s)))
(regexp-match ".*[.](rkt|ss|scm)$" (path->string s)))
(define-namespace-anchor a)
@ -27,6 +27,9 @@
(regexp-match e (exn-message val))]
[else (error 'exn-pred "bad argument" e)]))))
args))
(define (cfile file)
((compile-zos #f) (list file) 'auto))
(define (exn-pred p)
(let ([sexp (with-handlers
@ -114,7 +117,26 @@
[current-output-port (open-output-nowhere)])
(dr p))))))
(provide go go/text just-one)
(define (compile-benchmarks)
(define (find dir)
(for/list ([d (directory-list dir)]
#:when (scheme-file? d))
d))
(define shootout (collection-path "tests" "racket" "benchmarks" "shootout" "typed"))
(define common (collection-path "tests" "racket" "benchmarks" "common" "typed"))
(define (mk path)
(make-test-suite (path->string path)
(for/list ([p (find path)])
(parameterize ([current-load-relative-directory
(path->complete-path path)]
[current-directory path])
(test-suite (path->string p)
(check-not-exn (λ () (cfile (build-path path p)))))))))
(test-suite "compiling"
(mk shootout)
(mk common)))
(provide go go/text just-one compile-benchmarks)

2
collects/tests/typed-scheme/optimizer/run.rkt
View File

@ -33,7 +33,7 @@
(vector-ref (current-command-line-arguments) 0)))
0 1)
(for/fold ((n-failures 0))
((gen (in-directory (build-path here "generic"))))
((gen (in-directory (build-path here "generic"))))
(+ n-failures (if (test gen) 0 1))))))
(unless (= n-failures 0)
(error (format "~a tests failed." n-failures))))

23
collects/tests/typed-scheme/run.rkt
View File

@ -6,21 +6,32 @@
(define exec (make-parameter go/text))
(define the-tests (make-parameter tests))
(define skip-all? #f)
(define nightly? (make-parameter #f))
(define opt? (make-parameter #f))
(define bench? (make-parameter #f))
(current-namespace (make-base-namespace))
(command-line
#:once-each
["--unit" "run just the unit tests" (the-tests unit-tests)]
["--int" "run just the integration tests" (the-tests int-tests)]
["--nightly" "for the nightly builds" (when (eq? 'cgc (system-type 'gc))
(set! skip-all? #t))]
["--nightly" "for the nightly builds" (nightly? #t)]
["--just" path "run only this test" (the-tests (just-one path))]
["--opt" "run the optimizer tests" (opt? #t)]
["--benchmarks" "compile the typed benchmarks" (bench? #t)]
["--gui" "run using the gui"
(if (gui-available?)
(begin (exec go))
(error "GUI not available"))]
)
(if skip-all?
(printf "Skipping Typed Racket tests.\n")
(unless (= 0 ((exec) (the-tests)))
(error "Typed Racket Tests did not pass.")))
(cond [(and (nightly?) (eq? 'cgc (system-type 'gc)))
(printf "Skipping Typed Racket tests.\n")]
[(unless (= 0 ((exec) (the-tests)))
(error "Typed Racket Tests did not pass."))
(when (opt?)
(parameterize ([current-command-line-arguments #()])
(dynamic-require '(file "optimizer/run.rkt") #f))
(printf "Typed Racket Optimizer tests passed"))
(when (bench?)
(unless (= 0 ((exec) (compile-benchmarks)))
(error "Typed Racket Tests did not pass.")))])