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

Make benchmarks not delete compiled code.

Browse Source
This commit is contained in:
Eric Dobson 2013-06-22 15:41:19 -07:00
parent 4c88924ef5
commit 760a48d70c
1 changed files with 10 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/main.rkt
View File

@ -3,7 +3,7 @@
(require rackunit rackunit/text-ui racket/file (require rackunit rackunit/text-ui racket/file
mzlib/etc racket/port mzlib/etc racket/port
compiler/compiler racket/promise compiler/compiler racket/promise
racket/match mzlib/compile racket/match syntax/modcode
racket/promise racket/promise
"unit-tests/all-tests.rkt" "unit-tests/all-tests.rkt"
"unit-tests/test-utils.rkt" "unit-tests/test-utils.rkt"
@ -29,8 +29,6 @@
[else (error 'exn-pred "bad argument" e)])))) [else (error 'exn-pred "bad argument" e)]))))
args)) args))
(define (cfile file)
((compile-zos #f) (list file) 'auto))
(define (exn-pred p) (define (exn-pred p)
(let ([sexp (with-handlers (let ([sexp (with-handlers
@ -95,25 +93,19 @@
(fail-tests))) (fail-tests)))
(define (compile-benchmarks) (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 shootout (collection-path "tests" "racket" "benchmarks" "shootout" "typed"))
(define common (collection-path "tests" "racket" "benchmarks" "common" "typed")) (define common (collection-path "tests" "racket" "benchmarks" "common" "typed"))
(define (mk path) (define (mk dir)
(make-test-suite (path->string path) (make-test-suite (path->string dir)
(for/list ([p (find path)]) (for/list ([file (in-list (directory-list dir))]
(parameterize ([current-load-relative-directory #:when (scheme-file? file))
(path->complete-path path)] (test-suite (path->string file)
[current-directory path]) (check-not-exn (λ ()
(test-suite (path->string p) (get-module-code (build-path dir file)
(check-not-exn (λ () (cfile (build-path path p))))))))) #:choose (lambda (src zo so) 'src))))))))
(test-suite "compiling" (test-suite "compiling"
(mk shootout) (mk shootout)
(delete-directory/files (build-path shootout "compiled")) (mk common)))
(mk common)
(delete-directory/files (build-path common "compiled"))))
(define (just-one p*) (define (just-one p*)