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

fix for automated running

Browse Source 
svn: r11903
This commit is contained in:
Sam Tobin-Hochstadt 2008-09-29 15:15:50 +00:00
parent 5844ef4a3d
commit b81ba54dae
1 changed files with 229 additions and 230 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/tests/match/plt-match-tests.ss
View File

@ -1,14 +1,17 @@
(module plt-match-tests mzscheme #lang scheme/base
(require (planet "test-compat2.ss" ("schematics" "schemeunit.plt" 2 10)))
(require (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2 10)))
(require mzlib/plt-match) (require (for-syntax scheme/base))
(require "match-tests.ss" "other-plt-tests.ss" "other-tests.ss" "examples.ss") (require (planet "test-compat2.ss" ("schematics" "schemeunit.plt" 2 10)))
(require (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2 10)))
(require (planet "views.ss" ("cobbe" "views.plt" 1 1))) (require mzlib/plt-match)
(define reg-tests (require "match-tests.ss" "other-plt-tests.ss" "other-tests.ss" "examples.ss")
(require (planet "views.ss" ("cobbe" "views.plt" 1 1)))
(define reg-tests
(make-test-suite "Tests for regressions" (make-test-suite "Tests for regressions"
(make-test-case "quote in qp" (make-test-case "quote in qp"
(assert eq? #t (match '(tile a b c) (assert eq? #t (match '(tile a b c)
@ -19,12 +22,12 @@
[`(tile ,@`(a b c)) [`(tile ,@`(a b c))
#t] #t]
[else #f]))))) [else #f])))))
(define cons-tests (define cons-tests
(make-test-suite "Tests for cons pattern" (make-test-suite "Tests for cons pattern"
(make-test-case "simple" (make-test-case "simple"
(assert = 3 (match (cons 1 2) [(cons a b) (+ a b)]))))) (assert = 3 (match (cons 1 2) [(cons a b) (+ a b)])))))
(define match-expander-tests (define match-expander-tests
(make-test-suite (make-test-suite
"Tests for define-match-expander" "Tests for define-match-expander"
(make-test-case "Trivial expander" (make-test-case "Trivial expander"
@ -112,7 +115,7 @@
)) ))
)) ))
(define simple-tests (define simple-tests
(make-test-suite (make-test-suite
"Some Simple Tests" "Some Simple Tests"
(make-test-case "Trivial" (make-test-case "Trivial"
@ -134,7 +137,7 @@
(assert-false (origin? (make-point 1 1))))) (assert-false (origin? (make-point 1 1)))))
)) ))
(define nonlinear-tests (define nonlinear-tests
(make-test-suite (make-test-suite
"Non-linear patterns" "Non-linear patterns"
(make-test-case "Very simple" (make-test-case "Very simple"
@ -148,7 +151,7 @@
(assert equal? '(3) (match '((3) (3)) [(list a a) a] [_ 5]))))) (assert equal? '(3) (match '((3) (3)) [(list a a) a] [_ 5])))))
(define doc-tests (define doc-tests
(make-test-suite (make-test-suite
"Tests from Help Desk Documentation" "Tests from Help Desk Documentation"
(make-test-case "match-let" (make-test-case "match-let"
@ -206,7 +209,7 @@
)) ))
(define plt-match-tests (define plt-match-tests
(make-test-suite "Tests for plt-match.ss" (make-test-suite "Tests for plt-match.ss"
doc-tests doc-tests
cons-tests cons-tests
@ -216,7 +219,7 @@
reg-tests reg-tests
)) ))
(define (run-tests) (define (run-tests)
(test/text-ui (make-test-suite "Match Tests" (test/text-ui (make-test-suite "Match Tests"
plt-match-tests plt-match-tests
match-tests match-tests
@ -225,9 +228,5 @@
other-tests other-tests
other-plt-tests other-plt-tests
))) )))
(if (getenv "PLT_TESTS") (unless (= 0 (run-tests))
(unless (parameterize ([current-output-port (open-output-string)])
(= 0 (run-tests)))
(error "Match Tests did not pass.")) (error "Match Tests did not pass."))
(run-tests))
)