diff --git a/collects/web-server/prototype-web-server/tests/certify-tests.ss b/collects/web-server/prototype-web-server/tests/certify-tests.ss index 7f751bacf2..b0ae4cadc8 100644 --- a/collects/web-server/prototype-web-server/tests/certify-tests.ss +++ b/collects/web-server/prototype-web-server/tests/certify-tests.ss @@ -3,6 +3,11 @@ "language-tester.ss") (provide certify-suite) + (define the-dispatch + `(lambda (k*v) + (lambda (k*v) + ((car k*v) k*v)))) + (define certify-suite (make-test-suite "Test the certification process" @@ -18,7 +23,7 @@ (provide start) (define (start initial) `(,@(list 1 2 initial)))))]) - (go) + (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))))) @@ -30,7 +35,7 @@ (provide start) (define (start initial) `(foo ,@(list 1 2 3)))))]) - (go) + (go the-dispatch) (assert-true #t))) (make-test-case @@ -41,7 +46,7 @@ (provide start) (define (start n) `(n ,@(list 1 2 3)))))]) - (go) + (go the-dispatch) (assert-true #t))) (make-test-case @@ -54,5 +59,5 @@ (define (bar n) `(n ,@(list 1 2 3))) (bar 7))))]) - (go) + (go the-dispatch) (assert-true #t))))))) \ No newline at end of file diff --git a/collects/web-server/prototype-web-server/tests/lang-tests.ss b/collects/web-server/prototype-web-server/tests/lang-tests.ss index 37744bb821..7c30983369 100644 --- a/collects/web-server/prototype-web-server/tests/lang-tests.ss +++ b/collects/web-server/prototype-web-server/tests/lang-tests.ss @@ -14,6 +14,11 @@ (raise the-exn)))]) (and (thunk) #f))) + (define the-dispatch + `(lambda (k*v) + (lambda (k*v) + ((car k*v) k*v)))) + (define lang-suite (make-test-suite "Test the Web language" @@ -33,7 +38,7 @@ (define (start initial) (let ([f (let ([m 7]) m)]) (+ f initial)))))]) - (go) + (go the-dispatch) (assert = 8 (test-m00.4 '(dispatch-start 1))))) (make-test-case @@ -45,7 +50,7 @@ (provide start) (define (start initial) (foo initial))))]) - (go) + (go the-dispatch) (assert eqv? 'foo (test-m00.3 '(dispatch-start 7))))) (make-test-case @@ -57,7 +62,7 @@ (provide start) (define (start initial) (id initial))))]) - (go) + (go the-dispatch) (assert = 7 (test-m00 '(dispatch-start 7))) (assert eqv? 'foo (test-m00 '(dispatch-start 'foo))))) @@ -69,7 +74,7 @@ (provide start) (define (start initial) (+ 1 initial))))]) - (go) + (go the-dispatch) (assert = 2 (test-m00.1 '(dispatch-start 1))))) (make-test-case @@ -80,7 +85,7 @@ (provide start) (define (start initial) (+ (+ 1 1) initial))))]) - (go) + (go the-dispatch) (assert = 14 (test-m00.2 '(dispatch-start 12))) (assert = 20 (test-m00.2 '(dispatch-start 18))))) @@ -92,7 +97,7 @@ (provide start) (define (start initial) (+ (* 1 2) (* 3 4) initial))))]) - (go) + (go the-dispatch) (assert = 14 (test-m01 '(dispatch-start 0))) (assert = 20 (test-m01 '(dispatch-start 6))))) @@ -130,7 +135,7 @@ (define (start x) (let/cc k (+ 2 4 (k 3) 6 8)))))]) - (go) + (go the-dispatch) (assert = 3 (test-m03 '(dispatch-start 'foo))) (assert = 3 (test-m03 '(dispatch-start 7))))) @@ -151,7 +156,7 @@ [else (* (car ln) (start (cdr ln)))])))))]) - (go) + (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)))))) @@ -177,7 +182,7 @@ [else (* (car ln) (mult/escape escape (cdr ln)))]))))]) - (go) + (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))))))) @@ -248,7 +253,7 @@ (let ([result (+ (gn "first") (gn "second"))]) (let ([ignore (printf "The answer is: ~s~n" result)]) result)))))]) - (go) + (go the-dispatch) (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)))]) @@ -279,7 +284,7 @@ (and (not (zero? n)) (even? (sub1 n))))]) (even? initial)))))]) - (go) + (go the-dispatch) (assert-true (test-m07 '(dispatch-start 0))) (assert-true (test-m07 '(dispatch-start 16))) (assert-false (test-m07 '(dispatch-start 1))) @@ -306,7 +311,7 @@ (let ([result (g (gn "third"))]) (let ([ignore (printf "The answer is: ~s~n" result)]) result))))))]) - (go) + (go the-dispatch) (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))))]) @@ -360,7 +365,7 @@ result)) (define (start ignore) (nta (lambda (x) (let/cc k (k x))) 7))))]) - (go) + (go the-dispatch) (assert = 7 (m10-eval '(dispatch-start 'foo))))) (make-test-case @@ -374,7 +379,7 @@ (map (lambda (x) (let/cc k k)) (list 1 2 3)))))]) - (go) + (go the-dispatch) (assert-true (catch-unsafe-context-exn (lambda () (m11-eval '(dispatch-start 'foo))))))) @@ -417,7 +422,7 @@ (let ([ignore (printf "n = ~s~n" n)]) k)))) (list 1 2 3)))))]) - (go) + (go the-dispatch) (assert-true (catch-unsafe-context-exn (lambda () (m13-eval '(dispatch-start 'foo))))))) diff --git a/collects/web-server/prototype-web-server/tests/language-tester.ss b/collects/web-server/prototype-web-server/tests/language-tester.ss index 1b45f4e0a8..0d8e1ce0bb 100644 --- a/collects/web-server/prototype-web-server/tests/language-tester.ss +++ b/collects/web-server/prototype-web-server/tests/language-tester.ss @@ -3,14 +3,12 @@ make-eval/mod-path) (define (go ns) - (lambda () + (lambda (dispatch-sexpr) (parameterize ([current-namespace ns]) - (eval '(run-start + (eval `(run-start (lambda () (start-interaction - (lambda (k*v) - (lambda (k*v) - ((car k*v) k*v))))) + ,dispatch-sexpr)) start))))) (define-syntax (make-module-eval m-expr) diff --git a/collects/web-server/prototype-web-server/tests/stuff-url-tests.ss b/collects/web-server/prototype-web-server/tests/stuff-url-tests.ss index 41d34c5465..613ff8888a 100644 --- a/collects/web-server/prototype-web-server/tests/stuff-url-tests.ss +++ b/collects/web-server/prototype-web-server/tests/stuff-url-tests.ss @@ -26,6 +26,11 @@ (let ([result-uri (stuff-url svl uri mod-path)]) (unstuff-url result-uri uri mod-path))) + (define the-dispatch + `(lambda (k*v) + (lambda (k*v) + ((car k*v) k*v)))) + (define stuff-url-suite (make-test-suite "Tests for stuff-url.ss" @@ -49,7 +54,7 @@ (make-test-case "compose url-parts and recover-serial (1)" (let-values ([(go ev) (make-eval/mod-path "modules/mm00.ss")]) - (go) + (go the-dispatch) (let* ([k0 (simplify-unsimplify (ev '(serialize (dispatch-start 'foo))) `(file "modules/mm00.ss"))] [k1 (simplify-unsimplify (ev `(serialize (dispatch (list (deserialize ',k0) 1)))) @@ -61,7 +66,7 @@ (make-test-case "compose url-parts and recover-serial (2)" (let-values ([(go ev) (make-eval/mod-path "modules/mm01.ss")]) - (go) + (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)))))))) @@ -69,7 +74,7 @@ (make-test-case "compose stuff-url and unstuff-url and recover the serial" (let-values ([(go ev) (make-eval/mod-path "modules/mm00.ss")]) - (go) + (go the-dispatch) (let* ([k0 (stuff-unstuff (ev '(serialize (dispatch-start 'foo))) uri0 `(file "modules/mm00.ss"))] [k1 (stuff-unstuff (ev `(serialize (dispatch (list (deserialize ',k0) 1))))