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

Cleanup of the test harness.

Browse Source
This commit is contained in:
Vincent St-Amour 2010-08-27 12:26:23 -04:00
parent 7cfba9f02d
commit 1c9e8e05b0
1 changed files with 4 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -6,8 +6,7 @@
(define (evaluator file #:optimize [optimize? #f]) (define (evaluator file #:optimize [optimize? #f])
(call-with-trusted-sandbox-configuration (call-with-trusted-sandbox-configuration
(lambda () (lambda ()
(parameterize ([current-load-relative-directory (parameterize ([current-load-relative-directory tests-dir]
(build-path here "tests")]
[sandbox-memory-limit #f] ; TR needs memory [sandbox-memory-limit #f] ; TR needs memory
[sandbox-output 'string] [sandbox-output 'string]
[sandbox-namespace-specs [sandbox-namespace-specs
@ -28,7 +27,7 @@
out))))) out)))))
(define (generate-opt-log name) (define (generate-opt-log name)
(parameterize ([current-load-relative-directory (build-path here "tests")] (parameterize ([current-load-relative-directory tests-dir]
[current-command-line-arguments '#("--log-optimizations")]) [current-command-line-arguments '#("--log-optimizations")])
(with-output-to-string (with-output-to-string
(lambda () (lambda ()
@ -56,7 +55,7 @@
(begin (printf "~a failed: result mismatch\n\n" name) (begin (printf "~a failed: result mismatch\n\n" name)
#f)))))) #f))))))
(define-runtime-path here ".") (define-runtime-path tests-dir "./tests")
(let ((n-failures (let ((n-failures
(if (> (vector-length (current-command-line-arguments)) 0) (if (> (vector-length (current-command-line-arguments)) 0)
@ -64,7 +63,7 @@
(vector-ref (current-command-line-arguments) 0))) (vector-ref (current-command-line-arguments) 0)))
0 1) 0 1)
(for/fold ((n-failures 0)) (for/fold ((n-failures 0))
((gen (in-directory (build-path here "tests")))) ((gen (in-directory tests-dir)))
(+ n-failures (if (test gen) 0 1)))))) (+ n-failures (if (test gen) 0 1))))))
(unless (= n-failures 0) (unless (= n-failures 0)
(error (format "~a tests failed." n-failures)))) (error (format "~a tests failed." n-failures))))