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

Add support for close-call tests to the TR test harness.

Browse Source
This commit is contained in:
Vincent St-Amour 2011-05-04 12:04:59 -04:00
parent 303e1f7f88
commit 2e0dd6467a
3 changed files with 15 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -120,7 +120,9 @@
[(equal? dir "succeed/") [(equal? dir "succeed/")
(lambda (p thnk) (check-not-exn thnk))] (lambda (p thnk) (check-not-exn thnk))]
[(equal? dir "optimizer/tests/") [(equal? dir "optimizer/tests/")
(lambda (p* thnk) (test-opt p))]))) (lambda (p* thnk) (test-opt p))]
[(equal? dir "optimizer/close-calls/")
(lambda (p* thnk) (test-close-call p))])))
(test-suite (test-suite
(path->string p) (path->string p)
(f (f
@ -139,4 +141,4 @@
(provide go go/text just-one (provide go go/text just-one
int-tests unit-tests compile-benchmarks int-tests unit-tests compile-benchmarks
optimization-tests) optimization-tests close-call-tests)

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

@ -2,7 +2,8 @@
(require racket/runtime-path (require racket/runtime-path
rackunit rackunit/text-ui) rackunit rackunit/text-ui)
(provide optimization-tests test-opt) (provide optimization-tests close-call-tests
test-opt test-close-call)
(define (generate-log name dir flags) (define (generate-log name dir flags)
;; some tests require other tests, so some fiddling is required ;; some tests require other tests, so some fiddling is required
@ -38,10 +39,13 @@
(define-runtime-path tests-dir "./tests") (define-runtime-path tests-dir "./tests")
(define-runtime-path close-calls-dir "./close-calls")
;; these two return lists of tests to be run for that category of tests ;; these two return lists of tests to be run for that category of tests
(define (test-opt name) (define (test-opt name)
(list (compare-logs name tests-dir '#("--log-optimizations")))) (list (compare-logs name tests-dir '#("--log-optimizations"))))
(define (test-close-call name)
(list (compare-logs name close-calls-dir '#("--log-close-calls"))))
;; proc returns the list of tests to be run on each file ;; proc returns the list of tests to be run on each file
(define (mk-suite suite-name dir proc) (define (mk-suite suite-name dir proc)
@ -57,3 +61,5 @@
(define optimization-tests (define optimization-tests
(mk-suite "Optimization Tests" tests-dir test-opt)) (mk-suite "Optimization Tests" tests-dir test-opt))
(define close-call-tests
(mk-suite "Close Call Tests" close-calls-dir test-close-call))

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

@ -8,6 +8,7 @@
(define unit? (make-parameter #f)) (define unit? (make-parameter #f))
(define int? (make-parameter #f)) (define int? (make-parameter #f))
(define opt? (make-parameter #f)) (define opt? (make-parameter #f))
(define close-calls? (make-parameter #f))
(define bench? (make-parameter #f)) (define bench? (make-parameter #f))
(define single (make-parameter #f)) (define single (make-parameter #f))
(current-namespace (make-base-namespace)) (current-namespace (make-base-namespace))
@ -16,10 +17,11 @@
["--unit" "run the unit tests" (unit? #t)] ["--unit" "run the unit tests" (unit? #t)]
["--int" "run the integration tests" (int? #t)] ["--int" "run the integration tests" (int? #t)]
["--opt" "run the optimization tests" (opt? #t)] ["--opt" "run the optimization tests" (opt? #t)]
["--close-calls" "run the close call tests" (close-calls? #t)]
["--benchmarks" "compile the typed benchmarks" (bench? #t)] ["--benchmarks" "compile the typed benchmarks" (bench? #t)]
["--just" path "run only this test" (single (just-one path))] ["--just" path "run only this test" (single (just-one path))]
["--nightly" "for the nightly builds" (begin (nightly? #t) (unit? #t) (opt? #t))] ["--nightly" "for the nightly builds" (begin (nightly? #t) (unit? #t) (opt? #t))]
["--all" "run all tests" (begin (unit? #t) (int? #t) (opt? #t) (bench? #t))] ["--all" "run all tests" (begin (unit? #t) (int? #t) (opt? #t) (close-calls? #t) (bench? #t))]
["--gui" "run using the gui" ["--gui" "run using the gui"
(if (gui-available?) (if (gui-available?)
(begin (exec go)) (begin (exec go))
@ -34,6 +36,7 @@
(append (if (unit?) (list unit-tests) '()) (append (if (unit?) (list unit-tests) '())
(if (int?) (list int-tests) '()) (if (int?) (list int-tests) '())
(if (opt?) (list optimization-tests) '()) (if (opt?) (list optimization-tests) '())
(if (close-calls?) (list close-call-tests) '())
(if (bench?) (list (compile-benchmarks)) '())))])]) (if (bench?) (list (compile-benchmarks)) '())))])])
(unless (= 0 ((exec) to-run)) (unless (= 0 ((exec) to-run))
(eprintf "Typed Racket Tests did not pass.\n")))) (eprintf "Typed Racket Tests did not pass.\n"))))