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 04b26bbcda..ebf340e93a 100644 --- a/collects/web-server/prototype-web-server/tests/certify-tests.ss +++ b/collects/web-server/prototype-web-server/tests/certify-tests.ss @@ -19,7 +19,7 @@ "quasi-quote with splicing: need to recertify context for qq-append" (let-values ([(go test-m01.1) (make-module-eval - (module m01.1 "../lang.ss" + (module m01.1 (lib "lang.ss" "web-server" "prototype-web-server") (provide start) (define (start initial) `(,@(list 1 2 initial)))))]) @@ -31,7 +31,7 @@ "recertify context test (1)" (let-values ([(go test-m01.2) (make-module-eval - (module m01.1 "../lang.ss" + (module m01.1 (lib "lang.ss" "web-server" "prototype-web-server") (provide start) (define (start initial) `(foo ,@(list 1 2 3)))))]) @@ -42,7 +42,7 @@ "recertify context test (2)" (let-values ([(go test-m01.3) (make-module-eval - (module m01.3 "../lang.ss" + (module m01.3 (lib "lang.ss" "web-server" "prototype-web-server") (provide start) (define (start n) `(n ,@(list 1 2 3)))))]) @@ -53,7 +53,7 @@ "recertify context test (3)" (let-values ([(go test-m01.4) (make-module-eval - (module m1 "../lang.ss" + (module m1 (lib "lang.ss" "web-server" "prototype-web-server") (provide start) (define (start initial) (define (bar n) 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 d1ceec0c03..922183cb79 100644 --- a/collects/web-server/prototype-web-server/tests/lang-tests.ss +++ b/collects/web-server/prototype-web-server/tests/lang-tests.ss @@ -33,7 +33,7 @@ "Function application with single argument in tail position" (let-values ([(go test-m00.4) (make-module-eval - (module m00.4 "../lang.ss" + (module m00.4 (lib "lang.ss" "web-server" "prototype-web-server") (provide start) (define (start initial) (let ([f (let ([m 7]) m)]) @@ -45,7 +45,7 @@ "start-interaction in argument position of a function call" (let-values ([(go test-m00.3) (make-module-eval - (module m00.3 "../lang.ss" + (module m00.3 (lib "lang.ss" "web-server" "prototype-web-server") (define (foo x) 'foo) (provide start) (define (start initial) @@ -57,7 +57,7 @@ "identity interaction, dispatch-start called multiple times" (let-values ([(go test-m00) (make-module-eval - (module m00 "../lang.ss" + (module m00 (lib "lang.ss" "web-server" "prototype-web-server") (define (id x) x) (provide start) (define (start initial) @@ -70,7 +70,7 @@ "start-interaction in argument position of a primitive" (let-values ([(go test-m00.1) (make-module-eval - (module m00.1 "../lang.ss" + (module m00.1 (lib "lang.ss" "web-server" "prototype-web-server") (provide start) (define (start initial) (+ 1 initial))))]) @@ -81,7 +81,7 @@ "dispatch-start called multiple times for s-i in non-trivial context" (let-values ([(go test-m00.2) (make-module-eval - (module m00.2 "../lang.ss" + (module m00.2 (lib "lang.ss" "web-server" "prototype-web-server") (provide start) (define (start initial) (+ (+ 1 1) initial))))]) @@ -93,7 +93,7 @@ "start-interaction in third position" (let-values ([(go test-m01) (make-module-eval - (module m01 "../lang.ss" + (module m01 (lib "lang.ss" "web-server" "prototype-web-server") (provide start) (define (start initial) (+ (* 1 2) (* 3 4) initial))))]) @@ -109,7 +109,7 @@ "start-interaction called twice, dispatch-start will invoke different continuations" (let ([test-m02 (make-module-eval - (module m02 "../lang.ss" + (module m02 (lib "lang.ss" "web-server" "prototype-web-server") (define (id x) x) (+ (start-interaction id) (start-interaction id))))]) @@ -130,7 +130,7 @@ "continuation invoked in non-trivial context from within proc" (let-values ([(go test-m03) (make-module-eval - (module m03 "../lang.ss" + (module m03 (lib "lang.ss" "web-server" "prototype-web-server") (provide start) (define (start x) (let/cc k @@ -146,7 +146,7 @@ "non-tail-recursive 'escaping' continuation" (let-values ([(go test-m04) (make-module-eval - (module m04 "../lang.ss" + (module m04 (lib "lang.ss" "web-server" "prototype-web-server") (provide start) (define (start ln) (let/cc k @@ -168,7 +168,7 @@ "tail-recursive escaping continuation" (let-values ([(go test-m05) (make-module-eval - (module m05 "../lang.ss" + (module m05 (lib "lang.ss" "web-server" "prototype-web-server") (provide start) (define (start ln) @@ -210,7 +210,7 @@ (define (lookup-k key-pair) (hash-table-get the-table (car key-pair) (lambda () #f)))))]) (table-01-eval - '(module m06 "../lang.ss" + '(module m06 (lib "lang.ss" "web-server" "prototype-web-server") (require table01) (provide start) @@ -273,7 +273,7 @@ "mutually recursive even? and odd?" (let-values ([(go test-m07) (make-module-eval - (module m07 "../lang.ss" + (module m07 (lib "lang.ss" "web-server" "prototype-web-server") (provide start) (define (start initial) (letrec ([even? (lambda (n) @@ -293,7 +293,7 @@ "send/suspend on rhs of letrec binding forms" (let-values ([(go test-m08) (make-module-eval - (module m08 "../lang.ss" + (module m08 (lib "lang.ss" "web-server" "prototype-web-server") (provide start) (define (gn which) (cadr @@ -340,7 +340,7 @@ (let ([result (apply f args)]) (printf "result = ~s~n" result) result))))]) - (nta-eval '(module m09 "../lang.ss" + (nta-eval '(module m09 (lib "lang.ss" "web-server" "prototype-web-server") (require nta) (provide start) (define (start ignore) @@ -356,7 +356,7 @@ (let-values ([(go m10-eval) (make-module-eval - (module m10 "../lang.ss" + (module m10 (lib "lang.ss" "web-server" "prototype-web-server") (provide start) (define (nta f arg) (let ([result (f arg)]) @@ -372,7 +372,7 @@ (let-values ([(go m11-eval) (make-module-eval - (module m11 "../lang.ss" + (module m11 (lib "lang.ss" "web-server" "prototype-web-server") (provide start) (define (start ignore) (map @@ -396,7 +396,7 @@ (define (tail-apply f . args) (apply f args))))]) - (ta-eval '(module m12 "../lang.ss" + (ta-eval '(module m12 (lib "lang.ss" "web-server" "prototype-web-server") (require ta) (provide start) (define (start initial) @@ -412,7 +412,7 @@ (let-values ([(go m13-eval) (make-module-eval - (module m11 "../lang.ss" + (module m11 (lib "lang.ss" "web-server" "prototype-web-server") (provide start) (define (start initial) (map @@ -437,7 +437,7 @@ (define (tail-apply f . args) (apply f args))))]) - (ta-eval '(module m14 "../lang.ss" + (ta-eval '(module m14 (lib "lang.ss" "web-server" "prototype-web-server") (require ta) (provide start) (define (start ignore) 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 6a2b767450..b5296e5fab 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 @@ -5,6 +5,7 @@ (lib "url.ss" "net") (lib "dirs.ss" "setup") (lib "file.ss") + (lib "etc.ss") "util.ss") (require/expose (lib "stuff-url.ss" "web-server" "prototype-web-server" "private") @@ -31,6 +32,9 @@ (lambda (k*v) ((car k*v) k*v)))) + (define m00 '(lib "mm00.ss" "web-server" "prototype-web-server" "tests" "modules")) + (define m01 '(lib "mm01.ss" "web-server" "prototype-web-server" "tests" "modules")) + (define stuff-url-suite (test-suite "Tests for stuff-url.ss" @@ -43,7 +47,7 @@ '(lib "abort-resume.ss" "web-server" "prototype-web-server" "private"))) (check-true - (same-module? `(file ,(path->string (build-absolute-path (current-directory) "../private/abort-resume.ss"))) + (same-module? `(file ,(path->string (build-absolute-path (this-expression-source-directory) "../private/abort-resume.ss"))) '(lib "abort-resume.ss" "web-server" "prototype-web-server" "private"))) (check-true @@ -53,32 +57,32 @@ (test-case "compose url-parts and recover-serial (1)" - (let-values ([(go ev) (make-eval/mod-path "modules/mm00.ss")]) + (let-values ([(go ev) (make-eval/mod-path m00)]) (go the-dispatch) (let* ([k0 (simplify-unsimplify (ev '(serialize (dispatch-start 'foo))) - `(file "modules/mm00.ss"))] + m00)] [k1 (simplify-unsimplify (ev `(serialize (dispatch (list (deserialize ',k0) 1)))) - `(file "modules/mm00.ss"))] + m00)] [k2 (simplify-unsimplify (ev `(serialize (dispatch (list (deserialize ',k1) 2)))) - `(file "modules/mm00.ss"))]) + m00)]) (check-true (= 6 (ev `(dispatch (list (deserialize ',k2) 3)))))))) (test-case "compose url-parts and recover-serial (2)" - (let-values ([(go ev) (make-eval/mod-path "modules/mm01.ss")]) + (let-values ([(go ev) (make-eval/mod-path m01)]) (go the-dispatch) (let* ([k0 (simplify-unsimplify (ev '(serialize (dispatch-start 'foo))) - `(file "modules/mm01.ss"))]) + m01)]) (check-true (= 7 (ev `(dispatch (list (deserialize ',k0) 7)))))))) - (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")]) + (let-values ([(go ev) (make-eval/mod-path m00)]) (go the-dispatch) (let* ([k0 (stuff-unstuff (ev '(serialize (dispatch-start 'foo))) - uri0 `(file "modules/mm00.ss"))] + uri0 m00)] [k1 (stuff-unstuff (ev `(serialize (dispatch (list (deserialize ',k0) 1)))) - uri0 `(file "modules/mm00.ss"))] + uri0 m00)] [k2 (stuff-unstuff (ev `(serialize (dispatch (list (deserialize ',k1) 2)))) - uri0 `(file "modules/mm00.ss"))]) + uri0 m00)]) (check-true (= 6 (ev `(dispatch (list (deserialize ',k2) 3))))))))))) \ No newline at end of file diff --git a/collects/web-server/prototype-web-server/tests/suite.ss b/collects/web-server/prototype-web-server/tests/suite.ss index a83ecf778d..c80f55fb56 100644 --- a/collects/web-server/prototype-web-server/tests/suite.ss +++ b/collects/web-server/prototype-web-server/tests/suite.ss @@ -13,10 +13,10 @@ (test/graphical-ui (test-suite "Main Tests for Prototype Web Server" - persistent-close-suite + #;persistent-close-suite stuff-url-suite - anormal-tests - closure-tests-suite - labels-tests-suite - lang-suite - certify-suite))) \ No newline at end of file + #;anormal-tests + #;closure-tests-suite + #;labels-tests-suite + #;lang-suite + #;certify-suite))) \ No newline at end of file diff --git a/collects/web-server/prototype-web-server/tests/util.ss b/collects/web-server/prototype-web-server/tests/util.ss index 7ac1363542..488b9e4ace 100644 --- a/collects/web-server/prototype-web-server/tests/util.ss +++ b/collects/web-server/prototype-web-server/tests/util.ss @@ -34,7 +34,7 @@ (parameterize ([current-namespace ns]) (eval `(require (lib "abort-resume.ss" "web-server" "prototype-web-server" "private") (lib "serialize.ss") - (file ,pth)))) + ,pth))) (values (go ns) (lambda (expr) (parameterize ([current-namespace ns])