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

Fixing old tests

Browse Source 
svn: r6282
This commit is contained in:
Jay McCarthy 2007-05-24 21:52:31 +00:00
parent a41797dacd
commit b82a2f7f8c
8 changed files with 24 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/web-server/prototype-web-server/elim-call-cc.ss
View File

@ -50,7 +50,7 @@
(#%app (lambda (#,cm)
(lambda (#,x)
(#%app abort
(lambda () (#%app resume #,ref-to-cm #,ref-to-x)))))
(lambda () (#%app resume #,ref-to-cm (#%app list #,ref-to-x))))))
(#%app activation-record-list))))))]
;; this is (w e) where e is not a w. (w w) handled in next case.
;; m00.4 in persistent-interaction-tests.ss tests this distinction

2
collects/web-server/prototype-web-server/tests/certify-error2.ss
View File

@ -1,2 +0,0 @@
(module certify-error2 "../persistent-interaction.ss"
(or #f #t))

4
collects/web-server/prototype-web-server/tests/closure-tests.ss
View File

@ -111,6 +111,4 @@
(assert = 3 (env5 'z))
(assert = 4 (env6 'x))
(assert = 5 (env6 'y))
(assert = 6 (env6 'z))))
)))
(assert = 6 (env6 'z)))))))

6
collects/web-server/prototype-web-server/tests/language-tester.ss
View File

@ -1,7 +1,7 @@
(module language-tester mzscheme
(provide make-module-eval
make-eval/mod-path)
(define-syntax (make-module-eval m-expr)
(syntax-case m-expr (module)
[(_ (module m-id . rest))
@ -23,7 +23,7 @@
(parameterize ([current-namespace ns])
(eval `(require (lib "client.ss" "web-server" "prototype-web-server")
(lib "serialize.ss")
(file ,pth)))
(file ,pth))))
(lambda (expr)
(parameterize ([current-namespace ns])
(eval expr)))))))
(eval expr))))))

2
collects/web-server/prototype-web-server/tests/persistent-interaction-tests.ss
View File

@ -8,7 +8,7 @@
(lambda (the-exn)
(or
(and
(regexp-match ".*Attempt to capture a continuation from within an unsafe context$"
(regexp-match ".*Attempt to capture a continuation from within an unsafe context"
(exn-message the-exn))
#t)
(raise the-exn)))])

3
collects/web-server/prototype-web-server/tests/start-server.ss
View File

@ -1,3 +0,0 @@
(require "../server.ss")
(define shutdown (serve 9000))

21
collects/web-server/prototype-web-server/tests/stuff-url-tests.ss
View File

@ -34,11 +34,11 @@
"Test same-module?"
(assert-true
(same-module? `(file ,(build-absolute-path (find-collects-dir) "web-server" "prototype-web-sever" "abort-resume.ss"))
(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
(same-module? `(file ,(build-absolute-path (current-directory) "../abort-resume.ss"))
(same-module? `(file ,(path->string (build-absolute-path (current-directory) "../abort-resume.ss")))
'(lib "abort-resume.ss" "web-server" "prototype-web-server")))
(assert-true
@ -49,25 +49,28 @@
(make-test-case
"compose url-parts and recover-serial (1)"
(let* ([ev (make-eval/mod-path "modules/mm00.ss")]
[k0 (simplify-unsimplify (ev '(serialize (dispatch-start 'foo))) "modules/mm00.ss")]
[k0 (simplify-unsimplify (ev '(serialize (dispatch-start 'foo)))
`(file "modules/mm00.ss"))]
[k1 (simplify-unsimplify (ev `(serialize (dispatch (list (deserialize ',k0) 1))))
"modules/mm00.ss")]
`(file "modules/mm00.ss"))]
[k2 (simplify-unsimplify (ev `(serialize (dispatch (list (deserialize ',k1) 2))))
"modules/mm00.ss")])
`(file "modules/mm00.ss"))])
(assert-true (= 6 (ev `(dispatch (list (deserialize ',k2) 3)))))))
(make-test-case
"compose url-parts and recover-serial (2)"
(let* ([ev (make-eval/mod-path "modules/mm01.ss")]
[k0 (simplify-unsimplify (ev '(serialize (dispatch-start 'foo))) "modules/mm01.ss")])
[k0 (simplify-unsimplify (ev '(serialize (dispatch-start 'foo)))
`(file "modules/mm01.ss"))])
(assert-true (= 7 (ev `(dispatch (list (deserialize ',k0) 7)))))))
(make-test-case
"compose stuff-url and unstuff-url and recover the serial"
(let* ([ev (make-eval/mod-path "modules/mm00.ss")]
[k0 (stuff-unstuff (ev '(serialize (dispatch-start 'foo))) uri0 "modules/mm00.ss")]
[k0 (stuff-unstuff (ev '(serialize (dispatch-start 'foo)))
uri0 `(file "modules/mm00.ss"))]
[k1 (stuff-unstuff (ev `(serialize (dispatch (list (deserialize ',k0) 1))))
uri0 "modules/mm00.ss")]
uri0 `(file "modules/mm00.ss"))]
[k2 (stuff-unstuff (ev `(serialize (dispatch (list (deserialize ',k1) 2))))
uri0 "modules/mm00.ss")])
uri0 `(file "modules/mm00.ss"))])
(assert-true (= 6 (ev `(dispatch (list (deserialize ',k2) 3))))))))))

12
collects/web-server/prototype-web-server/tests/test-normalizer.ss
View File

@ -285,9 +285,9 @@
; this is supported now
#;(make-test-case
"multiple body expressions in lambda"
(assert-true (check-unsupported-lambda
(normalize-term (expand (syntax (lambda (x y z) 3 4)))))))
"multiple body expressions in lambda"
(assert-true (check-unsupported-lambda
(normalize-term (expand (syntax (lambda (x y z) 3 4)))))))
(make-test-case
"zero-or-more argument lambda"
@ -301,9 +301,9 @@
(normalize-term (expand (syntax (let-values ([(x y) (values 1 2)]) (+ x y))))))))
; this is supported now
#; (make-test-case
"let/multiple clauses before body"
(assert-true (check-unsupported-let
(normalize-term (expand (syntax (let ([x 1] [y 2]) (+ x y)))))))))
"let/multiple clauses before body"
(assert-true (check-unsupported-let
(normalize-term (expand (syntax (let ([x 1] [y 2]) (+ x y)))))))))
(make-test-suite
"Miscellaneous tests"