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

Add --just flag for running tests.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2010-07-01 13:47:02 -04:00
parent 829689eb9d
commit 3d347f117b
2 changed files with 39 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -23,8 +23,9 @@
[(number? e)
(and (exn:fail:syntax? val)
(= e (length (exn:fail:syntax-exprs val))))]
[else
(regexp-match e (exn-message val))]))))
[(or (string? e) (regexp? e))
(regexp-match e (exn-message val))]
[else (error 'exn-pred "bad argument" e)]))))
args))
(define (exn-pred p)
@ -61,9 +62,8 @@
(make-test-suite dir tests)))
(define (dr p)
#;((compile-zos #f) (list p) 'auto)
(parameterize ([current-namespace (make-base-empty-namespace)])
(dynamic-require `(file ,(path->string p)) #f)))
(dynamic-require `(file ,(if (string? p) p (path->string p))) #f)))
(define succ-tests (mk-tests "succeed"
dr
@ -86,16 +86,35 @@
(test-suite "Typed Scheme Tests"
unit-tests int-tests))
(define (go [unit? #f] [int? #f]) (test/gui (cond [unit? unit-tests]
[int? int-tests]
[else tests])))
(define (go/text [unit? #f] [int? #f]) (run-tests
(cond [unit? unit-tests]
[int? int-tests]
[else tests])
'verbose))
(provide tests int-tests unit-tests)
(provide go go/text)
(define (go tests) (test/gui tests))
(define (go/text tests) (run-tests tests 'verbose))
(define (just-one p*)
(define-values (path p b) (split-path p*))
(define f
(if (equal? "fail/" (path->string path))
(lambda (p thnk)
(define-values (pred info) (exn-pred p))
(parameterize ([error-display-handler void])
(with-check-info
(['predicates info])
(check-exn pred thnk))))
(lambda (p thnk) (check-not-exn thnk))))
(test-suite
(path->string p)
(f
(build-path path p)
(lambda ()
(parameterize ([read-accept-reader #t]
[current-load-relative-directory
(path->complete-path path)]
[current-directory path]
[current-output-port (open-output-nowhere)])
(dr p))))))
(provide go go/text just-one)

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

@ -4,22 +4,23 @@
(require "main.ss")
(define exec (make-parameter go/text))
(define unit-only? (make-parameter #f))
(define int-only? (make-parameter #f))
(define the-tests (make-parameter tests))
(define skip-all? #f)
(current-namespace (make-base-namespace))
(command-line
#:once-each
["--unit" "run just the unit tests" (unit-only? #t)]
["--int" "run just the integration tests" (int-only? #t)]
["--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))]
["--just" path "run only this test" (the-tests (just-one path))]
["--gui" "run using the gui"
(if (gui-available?)
(begin (exec go))
(error "GUI not available"))])
(error "GUI not available"))]
)
(if skip-all?
(printf "Skipping Typed Racket tests.\n")
(unless (= 0 ((exec) (unit-only?) (int-only?)))
(unless (= 0 ((exec) (the-tests)))
(error "Typed Racket Tests did not pass.")))