Upgrading to new version of schemeunit
svn: r6300
This commit is contained in:
Jay McCarthy
parent
ec053fad62
commit
be9259d5ac
|
|
@ -1,5 +1,5 @@
|
|||
(module anormal-test mzscheme
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1))
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
"../lang/anormal.ss")
|
||||
(provide anormal-tests)
|
||||
|
||||
|
|
@ -135,98 +135,98 @@
|
|||
;; ACTUAL TESTS
|
||||
|
||||
(define anormal-tests
|
||||
(make-test-suite
|
||||
(test-suite
|
||||
"Tests for Normalization Phase"
|
||||
(make-test-suite
|
||||
(test-suite
|
||||
"Base Cases"
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"Top level identifier"
|
||||
(assert alpha= (normalize-term (expand (syntax car)))
|
||||
(check alpha= (normalize-term (expand (syntax car)))
|
||||
(expand (syntax car))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"Simple arithmetic expression"
|
||||
(assert alpha= (normalize-term (expand (syntax (+ 1 1))))
|
||||
(check alpha= (normalize-term (expand (syntax (+ 1 1))))
|
||||
(expand (syntax (+ 1 1)))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"lambda-expression with constant body"
|
||||
(assert alpha= (normalize-term (expand (syntax (lambda (x) 3))))
|
||||
(check alpha= (normalize-term (expand (syntax (lambda (x) 3))))
|
||||
(expand (syntax (lambda (x) 3)))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"lambda-expression with var-ref body"
|
||||
(assert alpha= (normalize-term (expand (syntax (lambda (x) x))))
|
||||
(check alpha= (normalize-term (expand (syntax (lambda (x) x))))
|
||||
(expand (syntax (lambda (x) x)))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"lambda-expression/constant-body/multiple formals"
|
||||
(assert alpha= (normalize-term (expand (syntax (lambda (x y z) 3))))
|
||||
(check alpha= (normalize-term (expand (syntax (lambda (x y z) 3))))
|
||||
(expand (syntax (lambda (x y z) 3)))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"one-armed-if"
|
||||
(assert alpha= (normalize-term (expand (syntax (if #t 1))))
|
||||
(check alpha= (normalize-term (expand (syntax (if #t 1))))
|
||||
(expand (syntax (if #t 1 (void))))))
|
||||
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"two-armed-if"
|
||||
(assert alpha= (normalize-term (expand (syntax (if #t 1 2))))
|
||||
(check alpha= (normalize-term (expand (syntax (if #t 1 2))))
|
||||
(expand (syntax (if #t 1 2)))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"let/var-ref in body"
|
||||
(assert alpha= (normalize-term (expand (syntax (let ([x 1]) x))))
|
||||
(check alpha= (normalize-term (expand (syntax (let ([x 1]) x))))
|
||||
(expand (syntax ((lambda (x) x) 1)))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"call to void"
|
||||
(assert alpha= (normalize-term (expand (syntax (void))))
|
||||
(check alpha= (normalize-term (expand (syntax (void))))
|
||||
(expand (syntax (void)))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"primitive application/multiple arguments"
|
||||
(assert alpha= (normalize-term (expand (syntax (+ 1 2 3))))
|
||||
(check alpha= (normalize-term (expand (syntax (+ 1 2 3))))
|
||||
(expand (syntax (+ 1 2 3)))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"empty-list"
|
||||
(assert alpha= (normalize-term (expand (syntax ())))
|
||||
(check alpha= (normalize-term (expand (syntax ())))
|
||||
(expand (syntax ()))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"qoted list of constants"
|
||||
(assert alpha= (normalize-term (expand (syntax '(1 2 3))))
|
||||
(check alpha= (normalize-term (expand (syntax '(1 2 3))))
|
||||
(expand (syntax '(1 2 3))))))
|
||||
|
||||
(make-test-suite
|
||||
(test-suite
|
||||
"Inductive Cases"
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"nested primitive applications with multiple arguments"
|
||||
(assert alpha= (normalize-term (expand (syntax (* (+ 1 2) 3))))
|
||||
(check alpha= (normalize-term (expand (syntax (* (+ 1 2) 3))))
|
||||
(expand (syntax ((lambda (x) (* x 3)) (+ 1 2))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"one-armed if with prim-app in test posn"
|
||||
(assert alpha= (normalize-term (expand (syntax (if (+ 1 2) 3))))
|
||||
(check alpha= (normalize-term (expand (syntax (if (+ 1 2) 3))))
|
||||
(expand (syntax ((lambda (x) (if x 3 (void))) (+ 1 2))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"two-armed if with prim-app in test posn"
|
||||
(assert alpha= (normalize-term (expand (syntax (if (+ 1 2) 3 4))))
|
||||
(check alpha= (normalize-term (expand (syntax (if (+ 1 2) 3 4))))
|
||||
(expand (syntax ((lambda (x) (if x 3 4)) (+ 1 2))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"nested single argument primitive applications"
|
||||
(assert alpha= (normalize-term (expand (syntax (* (+ 1)))))
|
||||
(check alpha= (normalize-term (expand (syntax (* (+ 1)))))
|
||||
(expand (syntax ((lambda (x0) (* x0)) (+ 1))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"deeply nested primitive applications"
|
||||
(assert alpha= (normalize-term (expand (syntax (* (+ (+ (+ 1 2) 3) 4) (+ 5 6)))))
|
||||
(check alpha= (normalize-term (expand (syntax (* (+ (+ (+ 1 2) 3) 4) (+ 5 6)))))
|
||||
(expand (syntax ((lambda (x0)
|
||||
((lambda (x1)
|
||||
((lambda (x2)
|
||||
|
|
@ -236,9 +236,9 @@
|
|||
(+ x0 3)))
|
||||
(+ 1 2))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"deeply nested primitive applications"
|
||||
(assert alpha= (normalize-term (expand (syntax (* (+ 1 2) (+ 1 (+ 2 (+ 3 4)))))))
|
||||
(check alpha= (normalize-term (expand (syntax (* (+ 1 2) (+ 1 (+ 2 (+ 3 4)))))))
|
||||
(expand (syntax ((lambda (x0)
|
||||
((lambda (x1)
|
||||
((lambda (x2)
|
||||
|
|
@ -249,93 +249,93 @@
|
|||
(+ 3 4)))
|
||||
(+ 1 2))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"if nested in test position"
|
||||
(assert alpha= (normalize-term (expand (syntax (if (if #t #f #t) #t #t))))
|
||||
(check alpha= (normalize-term (expand (syntax (if (if #t #f #t) #t #t))))
|
||||
(expand (syntax ((lambda (x) (if x #t #t)) (if #t #f #t))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"procedure/body has nested if"
|
||||
(assert alpha= (normalize-term (expand (syntax (lambda (x) (if (if x 1 2) 3 4)))))
|
||||
(check alpha= (normalize-term (expand (syntax (lambda (x) (if (if x 1 2) 3 4)))))
|
||||
(expand (syntax (lambda (x)
|
||||
((lambda (y0) (if y0 3 4))
|
||||
(if x 1 2)))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"constant 0-arg procedure application"
|
||||
(assert alpha= (normalize-term (expand (syntax ((lambda () 3)))))
|
||||
(check alpha= (normalize-term (expand (syntax ((lambda () 3)))))
|
||||
(expand (syntax ((lambda () 3))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"if with function application in test"
|
||||
(assert alpha= (normalize-term (expand (syntax (if ((lambda () 7)) 1 2))))
|
||||
(check alpha= (normalize-term (expand (syntax (if ((lambda () 7)) 1 2))))
|
||||
(expand (syntax ((lambda (x) (if x 1 2))
|
||||
((lambda () 7)))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"if with lambda-expression in consequent and alternative"
|
||||
(assert alpha= (normalize-term (expand (syntax ((if #t (lambda () 1) (lambda () 2))))))
|
||||
(check alpha= (normalize-term (expand (syntax ((if #t (lambda () 1) (lambda () 2))))))
|
||||
(expand (syntax ((lambda (x) (x)) (if #t (lambda () 1) (lambda () 2)))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"call/cc with value argument"
|
||||
(assert alpha= (normalize-term (expand (syntax (call/cc (lambda (x) x)))))
|
||||
(check alpha= (normalize-term (expand (syntax (call/cc (lambda (x) x)))))
|
||||
(expand (syntax (call/cc (lambda (x) x))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"call/cc with complex expression in argument"
|
||||
(assert alpha= (normalize-term (expand (syntax (call/cc (f (g 7))))))
|
||||
(check alpha= (normalize-term (expand (syntax (call/cc (f (g 7))))))
|
||||
(expand (syntax ((lambda (x0)
|
||||
((lambda (x1) (call/cc x1))
|
||||
(f x0)))
|
||||
(g 7)))))))
|
||||
|
||||
(make-test-suite
|
||||
(test-suite
|
||||
"Check that certain errors are raised"
|
||||
|
||||
; XXX Turn these tests into checking versions
|
||||
(make-test-case
|
||||
(test-case
|
||||
"multiple body expressions in lambda"
|
||||
(assert-true (check-supported
|
||||
(check-true (check-supported
|
||||
(normalize-term (expand (syntax (lambda (x y z) 3 4)))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"zero-or-more argument lambda"
|
||||
(assert-true (check-supported
|
||||
(check-true (check-supported
|
||||
(normalize-term (expand (syntax (lambda x x)))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"multi-valued let-values"
|
||||
(assert-true (check-supported
|
||||
(check-true (check-supported
|
||||
(normalize-term (expand (syntax (let-values ([(x y) (values 1 2)]) (+ x y))))))))
|
||||
(make-test-case
|
||||
(test-case
|
||||
"let/multiple clauses before body"
|
||||
(assert-true (check-supported
|
||||
(check-true (check-supported
|
||||
(normalize-term (expand (syntax (let ([x 1] [y 2]) (+ x y)))))))))
|
||||
|
||||
(make-test-suite
|
||||
(test-suite
|
||||
"Miscellaneous tests"
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"empty begin"
|
||||
(assert alpha= (normalize-term (expand (syntax (begin))))
|
||||
(check alpha= (normalize-term (expand (syntax (begin))))
|
||||
(syntax (#%app (#%top . void)))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"begin with one expression"
|
||||
(assert alpha= (normalize-term (expand (syntax (begin 1))))
|
||||
(check alpha= (normalize-term (expand (syntax (begin 1))))
|
||||
(syntax (#%datum . 1))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"begin with multiple expressions"
|
||||
(assert alpha= (normalize-term (expand (syntax (begin 1 2 3))))
|
||||
(check alpha= (normalize-term (expand (syntax (begin 1 2 3))))
|
||||
(normalize-term (expand (syntax (let ([throw-away 1])
|
||||
(let ([throw-away 2])
|
||||
3)))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"cond expression"
|
||||
(assert-true
|
||||
(check-true
|
||||
(and
|
||||
(with-handlers ([(lambda (x) #t)
|
||||
(lambda (the-exn) #f)])
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
(module certify-tests mzscheme
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1))
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
"util.ss")
|
||||
(provide certify-suite)
|
||||
|
||||
|
|
@ -9,13 +9,13 @@
|
|||
((car k*v) k*v))))
|
||||
|
||||
(define certify-suite
|
||||
(make-test-suite
|
||||
(test-suite
|
||||
"Test the certification process"
|
||||
|
||||
(make-test-suite
|
||||
(test-suite
|
||||
"Splicing tests"
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"quasi-quote with splicing: need to recertify context for qq-append"
|
||||
(let-values ([(go test-m01.1)
|
||||
(make-module-eval
|
||||
|
|
@ -24,10 +24,10 @@
|
|||
(define (start initial)
|
||||
`(,@(list 1 2 initial)))))])
|
||||
(go the-dispatch)
|
||||
(assert equal? (list 1 2 3) (test-m01.1 '(dispatch-start 3)))
|
||||
(assert equal? (list 1 2 'foo) (test-m01.1 '(dispatch-start 'foo)))))
|
||||
(check equal? (list 1 2 3) (test-m01.1 '(dispatch-start 3)))
|
||||
(check equal? (list 1 2 'foo) (test-m01.1 '(dispatch-start 'foo)))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"recertify context test (1)"
|
||||
(let-values ([(go test-m01.2)
|
||||
(make-module-eval
|
||||
|
|
@ -36,9 +36,9 @@
|
|||
(define (start initial)
|
||||
`(foo ,@(list 1 2 3)))))])
|
||||
(go the-dispatch)
|
||||
(assert-true #t)))
|
||||
(check-true #t)))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"recertify context test (2)"
|
||||
(let-values ([(go test-m01.3)
|
||||
(make-module-eval
|
||||
|
|
@ -47,9 +47,9 @@
|
|||
(define (start n)
|
||||
`(n ,@(list 1 2 3)))))])
|
||||
(go the-dispatch)
|
||||
(assert-true #t)))
|
||||
(check-true #t)))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"recertify context test (3)"
|
||||
(let-values ([(go test-m01.4)
|
||||
(make-module-eval
|
||||
|
|
@ -60,4 +60,4 @@
|
|||
`(n ,@(list 1 2 3)))
|
||||
(bar 7))))])
|
||||
(go the-dispatch)
|
||||
(assert-true #t)))))))
|
||||
(check-true #t)))))))
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
(module closure-tests mzscheme
|
||||
(provide closure-tests-suite)
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1))
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
(lib "serialize.ss")
|
||||
(lib "match.ss")
|
||||
"../define-closure.ss")
|
||||
|
|
@ -50,48 +50,48 @@
|
|||
(define eval-app (make-clsr:eval-app (lambda () evaluate)))
|
||||
|
||||
(define closure-tests-suite
|
||||
(make-test-suite
|
||||
(test-suite
|
||||
"Tests for closure.ss"
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"serialize id procedure"
|
||||
(assert = 7 ((deserialize (serialize (make-id))) 7)))
|
||||
(check = 7 ((deserialize (serialize (make-id))) 7)))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"id procedure"
|
||||
(assert = 7 ((make-id) 7)))
|
||||
(check = 7 ((make-id) 7)))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"add-y procedure"
|
||||
(assert = 2 ((make-add-y (lambda () 1)) 1)))
|
||||
(check = 2 ((make-add-y (lambda () 1)) 1)))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"serialize the add-y procedure"
|
||||
(assert = 2 ((deserialize (serialize (make-add-y (lambda () 1)))) 1)))
|
||||
(check = 2 ((deserialize (serialize (make-add-y (lambda () 1)))) 1)))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"even-p procedure"
|
||||
(assert-true (even-p 8)))
|
||||
(check-true (even-p 8)))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"serialize the even-p procedure"
|
||||
(assert-true ((deserialize (serialize even-p)) 64)))
|
||||
(check-true ((deserialize (serialize even-p)) 64)))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"simple interpreter case"
|
||||
(assert = 3 (evaluate 3 (make-the-empty-env))))
|
||||
(check = 3 (evaluate 3 (make-the-empty-env))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"serialize simple interpreter case"
|
||||
(assert = 3 ((deserialize (serialize evaluate))
|
||||
(check = 3 ((deserialize (serialize evaluate))
|
||||
3
|
||||
(deserialize (serialize (make-the-empty-env))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"apply identity"
|
||||
(assert = 3 (evaluate '((lambda (x) x) 3) (make-the-empty-env))))
|
||||
(check = 3 (evaluate '((lambda (x) x) 3) (make-the-empty-env))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"serialize environments"
|
||||
(let* ([e0 (make-the-empty-env)]
|
||||
[e1 (make-extended-env (lambda () (values e0 'x 1)))]
|
||||
|
|
@ -103,12 +103,12 @@
|
|||
[env3 (deserialize (serialize e3))]
|
||||
[env5 (deserialize (serialize e5))]
|
||||
[env6 (deserialize (serialize e6))])
|
||||
(assert = 1 (env3 'x))
|
||||
(assert = 2 (env3 'y))
|
||||
(assert = 3 (env3 'z))
|
||||
(assert = 4 (env5 'x))
|
||||
(assert = 5 (env5 'y))
|
||||
(assert = 3 (env5 'z))
|
||||
(assert = 4 (env6 'x))
|
||||
(assert = 5 (env6 'y))
|
||||
(assert = 6 (env6 'z)))))))
|
||||
(check = 1 (env3 'x))
|
||||
(check = 2 (env3 'y))
|
||||
(check = 3 (env3 'z))
|
||||
(check = 4 (env5 'x))
|
||||
(check = 5 (env5 'y))
|
||||
(check = 3 (env5 'z))
|
||||
(check = 4 (env6 'x))
|
||||
(check = 5 (env6 'y))
|
||||
(check = 6 (env6 'z)))))))
|
||||
|
|
@ -1,11 +1,11 @@
|
|||
(module labels-tests mzscheme
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1))
|
||||
(planet "util.ss" ("schematics" "schemeunit.plt" 1))
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
(planet "util.ss" ("schematics" "schemeunit.plt" 2))
|
||||
(lib "etc.ss")
|
||||
"../labels.ss")
|
||||
|
||||
|
||||
(require/expose "../labels.ss" (add1/string))
|
||||
(require/expose (lib "labels.ss" "web-server" "prototype-web-server") (add1/string))
|
||||
|
||||
(define THE-TEST-FILENAME "labels-test-file")
|
||||
|
||||
|
|
@ -78,35 +78,35 @@
|
|||
syms))))))
|
||||
|
||||
(define labels-tests-suite
|
||||
(make-test-suite
|
||||
(test-suite
|
||||
"Tests for labels.ss"
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"Test the tag incrementing scheme"
|
||||
(assert string=? "b" (add1/string ""))
|
||||
(assert string=? "A" (add1/string "z"))
|
||||
(assert string=? "B" (add1/string "A"))
|
||||
(assert string=? "b" (add1/string "a"))
|
||||
(assert string=? "ab" (add1/string "Z"))
|
||||
(assert string=? "aab" (add1/string "ZZ"))
|
||||
(assert string=? "Azz" (add1/string "zzz"))
|
||||
(assert string=? "aaaab" (add1/string "ZZZZ"))
|
||||
(assert string=? "baaab" (add1/string "aaaab")))
|
||||
(check string=? "b" (add1/string ""))
|
||||
(check string=? "A" (add1/string "z"))
|
||||
(check string=? "B" (add1/string "A"))
|
||||
(check string=? "b" (add1/string "a"))
|
||||
(check string=? "ab" (add1/string "Z"))
|
||||
(check string=? "aab" (add1/string "ZZ"))
|
||||
(check string=? "Azz" (add1/string "zzz"))
|
||||
(check string=? "aaaab" (add1/string "ZZZZ"))
|
||||
(check string=? "baaab" (add1/string "aaaab")))
|
||||
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"The same program produces the same labeling"
|
||||
(assert-eqv? (l1) (l2))
|
||||
(assert-eqv? (l1) (l2)))
|
||||
(check-eqv? (l1) (l2))
|
||||
(check-eqv? (l1) (l2)))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"Different programs produce different labelings"
|
||||
(assert-false (eqv? (l3) (l4))))
|
||||
(check-false (eqv? (l3) (l4))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"Check for race condition on make-labeling"
|
||||
(assert-false (make-labeling-race? 256)))
|
||||
(check-false (make-labeling-race? 256)))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"Check for race condition on delete-tag-list!"
|
||||
(assert-false (delete-tag-list!-race? 256))))))
|
||||
(check-false (delete-tag-list!-race? 256))))))
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
(module lang-tests mzscheme
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 1 1))
|
||||
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
"util.ss")
|
||||
(provide lang-suite)
|
||||
|
||||
|
|
@ -20,16 +20,16 @@
|
|||
((car k*v) k*v))))
|
||||
|
||||
(define lang-suite
|
||||
(make-test-suite
|
||||
(test-suite
|
||||
"Test the Web language"
|
||||
|
||||
;; ****************************************
|
||||
;; ****************************************
|
||||
;; BASIC TESTS
|
||||
(make-test-suite
|
||||
(test-suite
|
||||
"Basic Tests"
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"Function application with single argument in tail position"
|
||||
(let-values ([(go test-m00.4)
|
||||
(make-module-eval
|
||||
|
|
@ -39,9 +39,9 @@
|
|||
(let ([f (let ([m 7]) m)])
|
||||
(+ f initial)))))])
|
||||
(go the-dispatch)
|
||||
(assert = 8 (test-m00.4 '(dispatch-start 1)))))
|
||||
(check = 8 (test-m00.4 '(dispatch-start 1)))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"start-interaction in argument position of a function call"
|
||||
(let-values ([(go test-m00.3)
|
||||
(make-module-eval
|
||||
|
|
@ -51,9 +51,9 @@
|
|||
(define (start initial)
|
||||
(foo initial))))])
|
||||
(go the-dispatch)
|
||||
(assert eqv? 'foo (test-m00.3 '(dispatch-start 7)))))
|
||||
(check eqv? 'foo (test-m00.3 '(dispatch-start 7)))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"identity interaction, dispatch-start called multiple times"
|
||||
(let-values ([(go test-m00)
|
||||
(make-module-eval
|
||||
|
|
@ -63,10 +63,10 @@
|
|||
(define (start initial)
|
||||
(id initial))))])
|
||||
(go the-dispatch)
|
||||
(assert = 7 (test-m00 '(dispatch-start 7)))
|
||||
(assert eqv? 'foo (test-m00 '(dispatch-start 'foo)))))
|
||||
(check = 7 (test-m00 '(dispatch-start 7)))
|
||||
(check eqv? 'foo (test-m00 '(dispatch-start 'foo)))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"start-interaction in argument position of a primitive"
|
||||
(let-values ([(go test-m00.1)
|
||||
(make-module-eval
|
||||
|
|
@ -75,9 +75,9 @@
|
|||
(define (start initial)
|
||||
(+ 1 initial))))])
|
||||
(go the-dispatch)
|
||||
(assert = 2 (test-m00.1 '(dispatch-start 1)))))
|
||||
(check = 2 (test-m00.1 '(dispatch-start 1)))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"dispatch-start called multiple times for s-i in non-trivial context"
|
||||
(let-values ([(go test-m00.2)
|
||||
(make-module-eval
|
||||
|
|
@ -86,10 +86,10 @@
|
|||
(define (start initial)
|
||||
(+ (+ 1 1) initial))))])
|
||||
(go the-dispatch)
|
||||
(assert = 14 (test-m00.2 '(dispatch-start 12)))
|
||||
(assert = 20 (test-m00.2 '(dispatch-start 18)))))
|
||||
(check = 14 (test-m00.2 '(dispatch-start 12)))
|
||||
(check = 20 (test-m00.2 '(dispatch-start 18)))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"start-interaction in third position"
|
||||
(let-values ([(go test-m01)
|
||||
(make-module-eval
|
||||
|
|
@ -98,14 +98,14 @@
|
|||
(define (start initial)
|
||||
(+ (* 1 2) (* 3 4) initial))))])
|
||||
(go the-dispatch)
|
||||
(assert = 14 (test-m01 '(dispatch-start 0)))
|
||||
(assert = 20 (test-m01 '(dispatch-start 6)))))
|
||||
(check = 14 (test-m01 '(dispatch-start 0)))
|
||||
(check = 20 (test-m01 '(dispatch-start 6)))))
|
||||
|
||||
;; start-interaction may be called mutitple times
|
||||
;; each call overwrites the previous interaction
|
||||
;; continuation with the latest one.
|
||||
; XXX We have taken this power away.
|
||||
#;(make-test-case
|
||||
#;(test-case
|
||||
"start-interaction called twice, dispatch-start will invoke different continuations"
|
||||
(let ([test-m02
|
||||
(make-module-eval
|
||||
|
|
@ -114,19 +114,19 @@
|
|||
(+ (start-interaction id)
|
||||
(start-interaction id))))])
|
||||
|
||||
(assert-true (void? (test-m02 '(dispatch-start 1))))
|
||||
(assert = 3 (test-m02 '(dispatch-start 2)))
|
||||
(assert = 0 (test-m02 '(dispatch-start -1))))))
|
||||
(check-true (void? (test-m02 '(dispatch-start 1))))
|
||||
(check = 3 (test-m02 '(dispatch-start 2)))
|
||||
(check = 0 (test-m02 '(dispatch-start -1))))))
|
||||
|
||||
|
||||
|
||||
;; ****************************************
|
||||
;; ****************************************
|
||||
;; TESTS INVOLVING CALL/CC
|
||||
(make-test-suite
|
||||
(test-suite
|
||||
"Tests Involving call/cc"
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"continuation invoked in non-trivial context from within proc"
|
||||
(let-values ([(go test-m03)
|
||||
(make-module-eval
|
||||
|
|
@ -136,13 +136,13 @@
|
|||
(let/cc k
|
||||
(+ 2 4 (k 3) 6 8)))))])
|
||||
(go the-dispatch)
|
||||
(assert = 3 (test-m03 '(dispatch-start 'foo)))
|
||||
(assert = 3 (test-m03 '(dispatch-start 7)))))
|
||||
(check = 3 (test-m03 '(dispatch-start 'foo)))
|
||||
(check = 3 (test-m03 '(dispatch-start 7)))))
|
||||
|
||||
;; in the following test, if you modify
|
||||
;; resume to print the "stack" you will
|
||||
;; see that this is not tail recursive
|
||||
(make-test-case
|
||||
(test-case
|
||||
"non-tail-recursive 'escaping' continuation"
|
||||
(let-values ([(go test-m04)
|
||||
(make-module-eval
|
||||
|
|
@ -157,14 +157,14 @@
|
|||
(* (car ln)
|
||||
(start (cdr ln)))])))))])
|
||||
(go the-dispatch)
|
||||
(assert = 0 (test-m04 '(dispatch-start (list 1 2 3 4 5 6 7 0 8 9))))
|
||||
(assert = 120 (test-m04 '(dispatch-start (list 1 2 3 4 5))))))
|
||||
(check = 0 (test-m04 '(dispatch-start (list 1 2 3 4 5 6 7 0 8 9))))
|
||||
(check = 120 (test-m04 '(dispatch-start (list 1 2 3 4 5))))))
|
||||
|
||||
;; this version captures the continuation
|
||||
;; outside the recursion and should be tail
|
||||
;; recursive. A "stack trace" reveals this
|
||||
;; as expected.
|
||||
(make-test-case
|
||||
(test-case
|
||||
"tail-recursive escaping continuation"
|
||||
(let-values ([(go test-m05)
|
||||
(make-module-eval
|
||||
|
|
@ -183,17 +183,17 @@
|
|||
(* (car ln)
|
||||
(mult/escape escape (cdr ln)))]))))])
|
||||
(go the-dispatch)
|
||||
(assert = 0 (test-m05 '(dispatch-start (list 1 2 3 0 4 5 6))))
|
||||
(assert = 120 (test-m05 '(dispatch-start (list 1 2 3 4 5)))))))
|
||||
(check = 0 (test-m05 '(dispatch-start (list 1 2 3 0 4 5 6))))
|
||||
(check = 120 (test-m05 '(dispatch-start (list 1 2 3 4 5)))))))
|
||||
|
||||
;; ****************************************
|
||||
;; ****************************************
|
||||
;; TESTS INVOLVING send/suspend
|
||||
(make-test-suite
|
||||
(test-suite
|
||||
"Tests Involving send/suspend"
|
||||
|
||||
; XXX This doesn't work, because we don't allow a different dispatcher
|
||||
#;(make-test-case
|
||||
#;(test-case
|
||||
"curried add with send/suspend"
|
||||
(let ([table-01-eval
|
||||
(make-module-eval
|
||||
|
|
@ -229,13 +229,13 @@
|
|||
(let* ([first-key (table-01-eval '(dispatch-start 'foo))]
|
||||
[second-key (table-01-eval `(dispatch '(,first-key 1)))]
|
||||
[third-key (table-01-eval `(dispatch '(,first-key -7)))])
|
||||
(assert = 3 (table-01-eval `(dispatch '(,second-key 2))))
|
||||
(assert = 4 (table-01-eval `(dispatch '(,second-key 3))))
|
||||
(assert-true (zero? (table-01-eval `(dispatch '(,second-key -1)))))
|
||||
(assert = -7 (table-01-eval `(dispatch '(,third-key 0))))
|
||||
(assert-true (zero? (table-01-eval `(dispatch '(,third-key 7))))))))
|
||||
(check = 3 (table-01-eval `(dispatch '(,second-key 2))))
|
||||
(check = 4 (table-01-eval `(dispatch '(,second-key 3))))
|
||||
(check-true (zero? (table-01-eval `(dispatch '(,second-key -1)))))
|
||||
(check = -7 (table-01-eval `(dispatch '(,third-key 0))))
|
||||
(check-true (zero? (table-01-eval `(dispatch '(,third-key 7))))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"curried with send/suspend and serializaztion"
|
||||
|
||||
(let-values ([(go test-m06.1)
|
||||
|
|
@ -257,20 +257,19 @@
|
|||
(let* ([first-key (test-m06.1 '(dispatch-start 'foo))]
|
||||
[second-key (test-m06.1 `(dispatch (list (deserialize (serialize ,first-key)) 1)))]
|
||||
[third-key (test-m06.1 `(dispatch (list (deserialize (serialize ,first-key)) -7)))])
|
||||
(values
|
||||
(assert = 3 (test-m06.1 `(dispatch (list ,second-key 2))))
|
||||
(assert = 4 (test-m06.1 `(dispatch (list ,second-key 3))))
|
||||
(assert-true (zero? (test-m06.1 `(dispatch (list ,second-key -1)))))
|
||||
(assert = -7 (test-m06.1 `(dispatch (list ,third-key 0))))
|
||||
(assert-true (zero? (test-m06.1 `(dispatch (list ,third-key 7))))))))))
|
||||
(check = 3 (test-m06.1 `(dispatch (list ,second-key 2))))
|
||||
(check = 4 (test-m06.1 `(dispatch (list ,second-key 3))))
|
||||
(check-true (zero? (test-m06.1 `(dispatch (list ,second-key -1)))))
|
||||
(check = -7 (test-m06.1 `(dispatch (list ,third-key 0))))
|
||||
(check-true (zero? (test-m06.1 `(dispatch (list ,third-key 7)))))))))
|
||||
|
||||
;; ****************************************
|
||||
;; ****************************************
|
||||
;; TESTS INVOLVING LETREC
|
||||
(make-test-suite
|
||||
(test-suite
|
||||
"Tests Involving letrec"
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"mutually recursive even? and odd?"
|
||||
(let-values ([(go test-m07)
|
||||
(make-module-eval
|
||||
|
|
@ -285,12 +284,12 @@
|
|||
(even? (sub1 n))))])
|
||||
(even? initial)))))])
|
||||
(go the-dispatch)
|
||||
(assert-true (test-m07 '(dispatch-start 0)))
|
||||
(assert-true (test-m07 '(dispatch-start 16)))
|
||||
(assert-false (test-m07 '(dispatch-start 1)))
|
||||
(assert-false (test-m07 '(dispatch-start 7)))))
|
||||
(check-true (test-m07 '(dispatch-start 0)))
|
||||
(check-true (test-m07 '(dispatch-start 16)))
|
||||
(check-false (test-m07 '(dispatch-start 1)))
|
||||
(check-false (test-m07 '(dispatch-start 7)))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"send/suspend on rhs of letrec binding forms"
|
||||
(let-values ([(go test-m08)
|
||||
(make-module-eval
|
||||
|
|
@ -315,21 +314,21 @@
|
|||
(let* ([k0 (test-m08 '(serialize (dispatch-start 'foo)))]
|
||||
[k1 (test-m08 `(serialize (dispatch (list (deserialize ',k0) 1))))]
|
||||
[k2 (test-m08 `(serialize (dispatch (list (deserialize ',k1) 2))))])
|
||||
(assert = 6 (test-m08 `(dispatch (list (deserialize ',k2) 3))))
|
||||
(assert = 9 (test-m08 `(dispatch (list (deserialize ',k2) 6))))
|
||||
(check = 6 (test-m08 `(dispatch (list (deserialize ',k2) 3))))
|
||||
(check = 9 (test-m08 `(dispatch (list (deserialize ',k2) 6))))
|
||||
(let* ([k1.1 (test-m08 `(serialize (dispatch (list (deserialize ',k0) -1))))]
|
||||
[k2.1 (test-m08 `(serialize (dispatch (list (deserialize ',k1.1) -2))))])
|
||||
(assert-true (zero? (test-m08 `(dispatch (list (deserialize ',k2.1) 3)))))
|
||||
(assert = 6 (test-m08 `(dispatch (list (deserialize ',k2) 3)))))))))
|
||||
(check-true (zero? (test-m08 `(dispatch (list (deserialize ',k2.1) 3)))))
|
||||
(check = 6 (test-m08 `(dispatch (list (deserialize ',k2) 3)))))))))
|
||||
|
||||
;; ****************************************
|
||||
;; ****************************************
|
||||
;; TEST UNSAFE CONTEXT CONDITION
|
||||
(make-test-suite
|
||||
(test-suite
|
||||
"Unsafe Context Condition Tests"
|
||||
|
||||
; XXX Bizarre
|
||||
#;(make-test-case
|
||||
#;(test-case
|
||||
"simple attempt to capture a continuation from an unsafe context"
|
||||
|
||||
(let-values ([(go nta-eval)
|
||||
|
|
@ -349,10 +348,10 @@
|
|||
|
||||
(nta-eval '(require m09))
|
||||
|
||||
(assert-true (catch-unsafe-context-exn
|
||||
(lambda () (nta-eval '(dispatch-start 'foo)))))))
|
||||
(check-true (catch-unsafe-context-exn
|
||||
(lambda () (nta-eval '(dispatch-start 'foo)))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"sanity-check: capture continuation from safe version of context"
|
||||
|
||||
(let-values ([(go m10-eval)
|
||||
|
|
@ -366,9 +365,9 @@
|
|||
(define (start ignore)
|
||||
(nta (lambda (x) (let/cc k (k x))) 7))))])
|
||||
(go the-dispatch)
|
||||
(assert = 7 (m10-eval '(dispatch-start 'foo)))))
|
||||
(check = 7 (m10-eval '(dispatch-start 'foo)))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"attempt continuation capture from standard call to map"
|
||||
|
||||
(let-values ([(go m11-eval)
|
||||
|
|
@ -380,13 +379,13 @@
|
|||
(lambda (x) (let/cc k k))
|
||||
(list 1 2 3)))))])
|
||||
(go the-dispatch)
|
||||
(assert-true (catch-unsafe-context-exn
|
||||
(lambda () (m11-eval '(dispatch-start 'foo)))))))
|
||||
(check-true (catch-unsafe-context-exn
|
||||
(lambda () (m11-eval '(dispatch-start 'foo)))))))
|
||||
|
||||
;; if the continuation-capture is attempted in tail position then we
|
||||
;; should be just fine.
|
||||
; XXX Weird
|
||||
#;(make-test-case
|
||||
#;(test-case
|
||||
"continuation capture from tail position of untranslated procedure"
|
||||
|
||||
(let ([ta-eval
|
||||
|
|
@ -406,9 +405,9 @@
|
|||
|
||||
(ta-eval '(require m12))
|
||||
|
||||
(assert = 2 (ta-eval '(dispatch-start 1)))))
|
||||
(check = 2 (ta-eval '(dispatch-start 1)))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"attempt send/suspend from standard call to map"
|
||||
|
||||
(let-values ([(go m13-eval)
|
||||
|
|
@ -423,11 +422,11 @@
|
|||
k))))
|
||||
(list 1 2 3)))))])
|
||||
(go the-dispatch)
|
||||
(assert-true (catch-unsafe-context-exn
|
||||
(lambda () (m13-eval '(dispatch-start 'foo)))))))
|
||||
(check-true (catch-unsafe-context-exn
|
||||
(lambda () (m13-eval '(dispatch-start 'foo)))))))
|
||||
|
||||
; XXX Weird
|
||||
#;(make-test-case
|
||||
#;(test-case
|
||||
"attempt send/suspend from tail position of untranslated procedure"
|
||||
|
||||
(let-values ([(go ta-eval)
|
||||
|
|
@ -452,5 +451,5 @@
|
|||
(ta-eval '(require m14))
|
||||
|
||||
(let ([k0 (ta-eval '(dispatch-start 'foo))])
|
||||
(assert = 3 (ta-eval `(dispatch (list ,k0 2))))
|
||||
(assert = 0 (ta-eval `(dispatch (list ,k0 -1)))))))))))
|
||||
(check = 3 (ta-eval `(dispatch (list ,k0 2))))
|
||||
(check = 0 (ta-eval `(dispatch (list ,k0 -1)))))))))))
|
||||
|
|
@ -1,38 +1,38 @@
|
|||
(module persistent-close-tests mzscheme
|
||||
(require (lib "file-vector.ss" "web-server" "prototype-web-server" "graveyard")
|
||||
(planet "test.ss" ("schematics" "schemeunit.plt" 1 1))
|
||||
(planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
(lib "serialize.ss")
|
||||
(lib "persistent-close.ss" "web-server" "prototype-web-server" "graveyard"))
|
||||
|
||||
(provide persistent-close-suite)
|
||||
|
||||
(define persistent-close-suite
|
||||
(make-test-suite
|
||||
(test-suite
|
||||
"tests for persistent-close.ss"
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"file-vector references"
|
||||
(let ([fv (make-file-vector 'foo 1 2 3)])
|
||||
(assert = 1 (file-vector-ref fv 0))
|
||||
(assert = 2 (file-vector-ref fv 1))
|
||||
(assert = 3 (file-vector-ref fv 2))
|
||||
(check = 1 (file-vector-ref fv 0))
|
||||
(check = 2 (file-vector-ref fv 1))
|
||||
(check = 3 (file-vector-ref fv 2))
|
||||
(file-vector-set! fv 0 -1)
|
||||
(file-vector-set! fv 1 -2)
|
||||
(file-vector-set! fv 2 -3)
|
||||
(assert = -1 (file-vector-ref fv 0))
|
||||
(assert = -2 (file-vector-ref fv 1))
|
||||
(assert = -3 (file-vector-ref fv 2))))
|
||||
(check = -1 (file-vector-ref fv 0))
|
||||
(check = -2 (file-vector-ref fv 1))
|
||||
(check = -3 (file-vector-ref fv 2))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"serializing file vectors"
|
||||
(let* ([fv (make-file-vector 'foo -1 -2 -3)]
|
||||
[fv2 (deserialize (serialize fv))])
|
||||
(assert = -1 (file-vector-ref fv2 0))
|
||||
(assert = -2 (file-vector-ref fv2 1))
|
||||
(assert = -3 (file-vector-ref fv2 2))))
|
||||
(check = -1 (file-vector-ref fv2 0))
|
||||
(check = -2 (file-vector-ref fv2 1))
|
||||
(check = -3 (file-vector-ref fv2 2))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"close/file test"
|
||||
(let ([x 7] [y 8])
|
||||
(assert = 7 (close/file 'f1 (x y) x))
|
||||
(assert = 15 (close/file 'f2 (x y) (+ x y))))))))
|
||||
(check = 7 (close/file 'f1 (x y) x))
|
||||
(check = 15 (close/file 'f2 (x y) (+ x y))))))))
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
(module stuff-url-tests mzscheme
|
||||
(require (lib "stuff-url.ss" "web-server" "prototype-web-server")
|
||||
(planet "test.ss" ("schematics" "schemeunit.plt" 1 1))
|
||||
(planet "util.ss" ("schematics" "schemeunit.plt" 1))
|
||||
(planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
(planet "util.ss" ("schematics" "schemeunit.plt" 2))
|
||||
(lib "url.ss" "net")
|
||||
(lib "dirs.ss" "setup")
|
||||
(lib "file.ss")
|
||||
|
|
@ -32,26 +32,26 @@
|
|||
((car k*v) k*v))))
|
||||
|
||||
(define stuff-url-suite
|
||||
(make-test-suite
|
||||
(test-suite
|
||||
"Tests for stuff-url.ss"
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"Test same-module?"
|
||||
|
||||
(assert-true
|
||||
(check-true
|
||||
(same-module? `(file ,(path->string (build-absolute-path (find-collects-dir) "web-server" "prototype-web-server" "abort-resume.ss")))
|
||||
'(lib "abort-resume.ss" "web-server" "prototype-web-server")))
|
||||
|
||||
(assert-true
|
||||
(check-true
|
||||
(same-module? `(file ,(path->string (build-absolute-path (current-directory) "../abort-resume.ss")))
|
||||
'(lib "abort-resume.ss" "web-server" "prototype-web-server")))
|
||||
|
||||
(assert-true
|
||||
(check-true
|
||||
(same-module?
|
||||
'(lib "abort-resume.ss" "web-server" "prototype-web-server")
|
||||
'(lib "./abort-resume.ss" "web-server" "prototype-web-server"))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"compose url-parts and recover-serial (1)"
|
||||
(let-values ([(go ev) (make-eval/mod-path "modules/mm00.ss")])
|
||||
(go the-dispatch)
|
||||
|
|
@ -61,17 +61,17 @@
|
|||
`(file "modules/mm00.ss"))]
|
||||
[k2 (simplify-unsimplify (ev `(serialize (dispatch (list (deserialize ',k1) 2))))
|
||||
`(file "modules/mm00.ss"))])
|
||||
(assert-true (= 6 (ev `(dispatch (list (deserialize ',k2) 3))))))))
|
||||
(check-true (= 6 (ev `(dispatch (list (deserialize ',k2) 3))))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"compose url-parts and recover-serial (2)"
|
||||
(let-values ([(go ev) (make-eval/mod-path "modules/mm01.ss")])
|
||||
(go the-dispatch)
|
||||
(let* ([k0 (simplify-unsimplify (ev '(serialize (dispatch-start 'foo)))
|
||||
`(file "modules/mm01.ss"))])
|
||||
(assert-true (= 7 (ev `(dispatch (list (deserialize ',k0) 7))))))))
|
||||
(check-true (= 7 (ev `(dispatch (list (deserialize ',k0) 7))))))))
|
||||
|
||||
(make-test-case
|
||||
(test-case
|
||||
"compose stuff-url and unstuff-url and recover the serial"
|
||||
(let-values ([(go ev) (make-eval/mod-path "modules/mm00.ss")])
|
||||
(go the-dispatch)
|
||||
|
|
@ -81,4 +81,4 @@
|
|||
uri0 `(file "modules/mm00.ss"))]
|
||||
[k2 (stuff-unstuff (ev `(serialize (dispatch (list (deserialize ',k1) 2))))
|
||||
uri0 `(file "modules/mm00.ss"))])
|
||||
(assert-true (= 6 (ev `(dispatch (list (deserialize ',k2) 3)))))))))))
|
||||
(check-true (= 6 (ev `(dispatch (list (deserialize ',k2) 3)))))))))))
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
(module suite mzscheme
|
||||
(require (planet "graphical-ui.ss" ("schematics" "schemeunit.plt" 1))
|
||||
(planet "text-ui.ss" ("schematics" "schemeunit.plt" 1))
|
||||
(planet "test.ss" ("schematics" "schemeunit.plt" 1 1))
|
||||
(require (planet "graphical-ui.ss" ("schematics" "schemeunit.plt" 2))
|
||||
(planet "text-ui.ss" ("schematics" "schemeunit.plt" 2))
|
||||
(planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
||||
"persistent-close-tests.ss"
|
||||
"anormal-test.ss"
|
||||
"closure-tests.ss"
|
||||
|
|
@ -11,7 +11,7 @@
|
|||
"stuff-url-tests.ss")
|
||||
|
||||
(test/graphical-ui
|
||||
(make-test-suite
|
||||
(test-suite
|
||||
"Main Tests for Prototype Web Server"
|
||||
persistent-close-suite
|
||||
stuff-url-suite
|
||||
|
|
@ -19,5 +19,4 @@
|
|||
closure-tests-suite
|
||||
labels-tests-suite
|
||||
lang-suite
|
||||
certify-suite
|
||||
)))
|
||||
certify-suite)))
|
||||
Loading…
Reference in New Issue
Block a user