diff --git a/collects/web-server/tests/modules/mm00.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/mm00.ss similarity index 100% rename from collects/web-server/tests/modules/mm00.ss rename to collects/web-server/default-web-root/htdocs/lang-servlets/mm00.ss diff --git a/collects/web-server/tests/modules/mm01.ss b/collects/web-server/default-web-root/htdocs/lang-servlets/mm01.ss similarity index 100% rename from collects/web-server/tests/modules/mm01.ss rename to collects/web-server/default-web-root/htdocs/lang-servlets/mm01.ss diff --git a/collects/web-server/tests/all-web-server-tests.ss b/collects/web-server/tests/all-web-server-tests.ss new file mode 100644 index 0000000000..cfccb35af4 --- /dev/null +++ b/collects/web-server/tests/all-web-server-tests.ss @@ -0,0 +1,25 @@ +(module all-web-server-tests mzscheme + (require (planet "graphical-ui.ss" ("schematics" "schemeunit.plt" 2)) + (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2)) + (planet "test.ss" ("schematics" "schemeunit.plt" 2)) + "./graveyard/persistent-close-test.ss" + "./lang/anormal-test.ss" + "./lang/labels-test.ss" + "./lang/stuff-url-test.ss" + "./lang/web-param-test.ss" + "./lang-test.ss" + "./private/define-closure-test.ss" + "./private/request-test.ss" + "./servlet-env-test.ss") + + (test/graphical-ui + (test-suite + "Web Server" + persistent-close-tests + anormal-tests + labels-tests + stuff-url-tests + web-param-tests + lang-tests + define-closure-tests + request-tests))) \ No newline at end of file diff --git a/collects/web-server/tests/certify-tests.ss b/collects/web-server/tests/certify-tests.ss deleted file mode 100644 index c4159a15d2..0000000000 --- a/collects/web-server/tests/certify-tests.ss +++ /dev/null @@ -1,54 +0,0 @@ -(module certify-tests mzscheme - (require (planet "test.ss" ("schematics" "schemeunit.plt" 2)) - "util.ss") - (provide certify-suite) - - (define certify-suite - (test-suite - "Test the certification process" - - (test-suite - "Splicing tests" - - (test-case - "quasi-quote with splicing: need to recertify context for qq-append" - (let-values ([(test-m01.1) - (make-module-eval - (module m01.1 (lib "lang.ss" "web-server") - (provide start) - (define (start initial) - `(,@(list 1 2 initial)))))]) - (check equal? (list 1 2 3) (test-m01.1 '(dispatch-start start 3))) - (check equal? (list 1 2 'foo) (test-m01.1 '(dispatch-start start 'foo))))) - - (test-case - "recertify context test (1)" - (let-values ([(test-m01.2) - (make-module-eval - (module m01.1 (lib "lang.ss" "web-server") - (provide start) - (define (start initial) - `(foo ,@(list 1 2 3)))))]) - (check-true #t))) - - (test-case - "recertify context test (2)" - (let-values ([(test-m01.3) - (make-module-eval - (module m01.3 (lib "lang.ss" "web-server") - (provide start) - (define (start n) - `(n ,@(list 1 2 3)))))]) - (check-true #t))) - - (test-case - "recertify context test (3)" - (let-values ([(test-m01.4) - (make-module-eval - (module m1 (lib "lang.ss" "web-server") - (provide start) - (define (start initial) - (define (bar n) - `(n ,@(list 1 2 3))) - (bar 7))))]) - (check-true #t))))))) \ No newline at end of file diff --git a/collects/web-server/tests/persistent-close-tests.ss b/collects/web-server/tests/graveyard/persistent-close-test.ss similarity index 91% rename from collects/web-server/tests/persistent-close-tests.ss rename to collects/web-server/tests/graveyard/persistent-close-test.ss index 3d6cb395cd..83d9320dbf 100644 --- a/collects/web-server/tests/persistent-close-tests.ss +++ b/collects/web-server/tests/graveyard/persistent-close-test.ss @@ -1,12 +1,11 @@ -(module persistent-close-tests mzscheme +(module persistent-close-test mzscheme (require (lib "file-vector.ss" "web-server" "graveyard") (planet "test.ss" ("schematics" "schemeunit.plt" 2)) (lib "serialize.ss") - (lib "persistent-close.ss" "web-server" "graveyard")) + (lib "persistent-close.ss" "web-server" "graveyard")) + (provide persistent-close-tests) - (provide persistent-close-suite) - - (define persistent-close-suite + (define persistent-close-tests (test-suite "Tests for persistent-close.ss" diff --git a/collects/web-server/tests/lang-tests.ss b/collects/web-server/tests/lang-test.ss similarity index 90% rename from collects/web-server/tests/lang-tests.ss rename to collects/web-server/tests/lang-test.ss index 4491265db9..addac2a6c4 100644 --- a/collects/web-server/tests/lang-tests.ss +++ b/collects/web-server/tests/lang-test.ss @@ -1,7 +1,7 @@ -(module lang-tests mzscheme +(module lang-test mzscheme (require (planet "test.ss" ("schematics" "schemeunit.plt" 2)) "util.ss") - (provide lang-suite) + (provide lang-tests) (define (catch-unsafe-context-exn thunk) (with-handlers ([void @@ -19,7 +19,7 @@ (lambda (k*v) ((car k*v) k*v)))) - (define lang-suite + (define lang-tests (test-suite "Test the Web language" @@ -273,6 +273,55 @@ (check = -7 (test-m06.1 `(dispatch ,the-dispatch (list ,third-key 0)))) (check-true (zero? (test-m06.1 `(dispatch ,the-dispatch (list ,third-key 7))))))))) + (test-suite + "Test the certification process" + + (test-suite + "Splicing tests" + + (test-case + "quasi-quote with splicing: need to recertify context for qq-append" + (let-values ([(test-m01.1) + (make-module-eval + (module m01.1 (lib "lang.ss" "web-server") + (provide start) + (define (start initial) + `(,@(list 1 2 initial)))))]) + (check equal? (list 1 2 3) (test-m01.1 '(dispatch-start start 3))) + (check equal? (list 1 2 'foo) (test-m01.1 '(dispatch-start start 'foo))))) + + (test-case + "recertify context test (1)" + (let-values ([(test-m01.2) + (make-module-eval + (module m01.1 (lib "lang.ss" "web-server") + (provide start) + (define (start initial) + `(foo ,@(list 1 2 3)))))]) + (check-true #t))) + + (test-case + "recertify context test (2)" + (let-values ([(test-m01.3) + (make-module-eval + (module m01.3 (lib "lang.ss" "web-server") + (provide start) + (define (start n) + `(n ,@(list 1 2 3)))))]) + (check-true #t))) + + (test-case + "recertify context test (3)" + (let-values ([(test-m01.4) + (make-module-eval + (module m1 (lib "lang.ss" "web-server") + (provide start) + (define (start initial) + (define (bar n) + `(n ,@(list 1 2 3))) + (bar 7))))]) + (check-true #t))))) + (test-suite "Tests Involving letrec" diff --git a/collects/web-server/tests/anormal-test.ss b/collects/web-server/tests/lang/anormal-test.ss similarity index 99% rename from collects/web-server/tests/anormal-test.ss rename to collects/web-server/tests/lang/anormal-test.ss index 13c912829c..d27de6d9c7 100644 --- a/collects/web-server/tests/anormal-test.ss +++ b/collects/web-server/tests/lang/anormal-test.ss @@ -1,7 +1,7 @@ (module anormal-test mzscheme (require (planet "test.ss" ("schematics" "schemeunit.plt" 2)) - "../lang/anormal.ss" - "../lang/util.ss") + (lib "anormal.ss" "web-server" "lang") + (lib "util.ss" "web-server" "lang")) (provide anormal-tests) (define (empty-env var) diff --git a/collects/web-server/tests/labels-tests.ss b/collects/web-server/tests/lang/labels-test.ss similarity index 93% rename from collects/web-server/tests/labels-tests.ss rename to collects/web-server/tests/lang/labels-test.ss index 6326b19822..1beb27866c 100644 --- a/collects/web-server/tests/labels-tests.ss +++ b/collects/web-server/tests/lang/labels-test.ss @@ -1,16 +1,14 @@ -(module labels-tests mzscheme +(module labels-test mzscheme (require (planet "test.ss" ("schematics" "schemeunit.plt" 2)) (planet "util.ss" ("schematics" "schemeunit.plt" 2)) (lib "etc.ss") (lib "file.ss") - "../lang/labels.ss") - + (lib "labels.ss" "web-server" "lang")) + (provide labels-tests) + (require/expose (lib "labels.ss" "web-server" "lang") (add1/string)) - (define THE-TEST-FILENAME (make-temporary-file)) - - (provide labels-tests-suite) - + (define THE-TEST-FILENAME (make-temporary-file)) (define l1 (make-labeling #"foo" THE-TEST-FILENAME)) (define l2 (make-labeling #"foo" THE-TEST-FILENAME)) (define l3 (make-labeling #"bar" THE-TEST-FILENAME)) @@ -77,7 +75,7 @@ (eqv? sym0 sym)) syms)))))) - (define labels-tests-suite + (define labels-tests (test-suite "Tests for labels.ss" diff --git a/collects/web-server/tests/stuff-url-tests.ss b/collects/web-server/tests/lang/stuff-url-test.ss similarity index 86% rename from collects/web-server/tests/stuff-url-tests.ss rename to collects/web-server/tests/lang/stuff-url-test.ss index bdda1749d7..a98bb21682 100644 --- a/collects/web-server/tests/stuff-url-tests.ss +++ b/collects/web-server/tests/lang/stuff-url-test.ss @@ -1,11 +1,10 @@ -(module stuff-url-tests mzscheme +(module stuff-url-test mzscheme (require (lib "stuff-url.ss" "web-server" "lang") (lib "mod-map.ss" "web-server" "private") (planet "test.ss" ("schematics" "schemeunit.plt" 2)) (lib "url.ss" "net") - "util.ss") - - (provide stuff-url-suite) + "../util.ss") + (provide stuff-url-tests) (define uri0 (string->url "www.google.com")) @@ -23,10 +22,10 @@ (lambda (k*v) ((car k*v) k*v)))) - (define m00 '(lib "mm00.ss" "web-server" "tests" "modules")) - (define m01 '(lib "mm01.ss" "web-server" "tests" "modules")) + (define m00 '(lib "mm00.ss" "web-server" "default-web-root" "htdocs" "lang-servlets")) + (define m01 '(lib "mm01.ss" "web-server" "default-web-root" "htdocs" "lang-servlets")) - (define stuff-url-suite + (define stuff-url-tests (test-suite "Tests for stuff-url.ss" diff --git a/collects/web-server/tests/param-tests.ss b/collects/web-server/tests/lang/web-param-test.ss similarity index 93% rename from collects/web-server/tests/param-tests.ss rename to collects/web-server/tests/lang/web-param-test.ss index 45d12bb1ce..a75e6a481e 100644 --- a/collects/web-server/tests/param-tests.ss +++ b/collects/web-server/tests/lang/web-param-test.ss @@ -1,14 +1,14 @@ -(module param-tests mzscheme +(module web-param-test mzscheme (require (planet "test.ss" ("schematics" "schemeunit.plt" 2)) - "util.ss") - (provide param-suite) + "../util.ss") + (provide web-param-tests) (define the-dispatch `(lambda (k*v) (lambda (k*v) ((car k*v) k*v)))) - (define param-suite + (define web-param-tests (test-suite "Test Web Parameters" diff --git a/collects/web-server/tests/closure-tests.ss b/collects/web-server/tests/private/define-closure-test.ss similarity index 94% rename from collects/web-server/tests/closure-tests.ss rename to collects/web-server/tests/private/define-closure-test.ss index c7e39c4dfc..79bd271dc6 100644 --- a/collects/web-server/tests/closure-tests.ss +++ b/collects/web-server/tests/private/define-closure-test.ss @@ -1,9 +1,9 @@ -(module closure-tests mzscheme - (provide closure-tests-suite) +(module define-closure-test mzscheme (require (planet "test.ss" ("schematics" "schemeunit.plt" 2)) (lib "serialize.ss") (lib "match.ss") - "../private/define-closure.ss") + (lib "define-closure.ss" "web-server" "private")) + (provide define-closure-tests) (define-closure id (x) () x) @@ -49,7 +49,7 @@ (define evaluate (make-clsr:evaluate (lambda () (values evaluate eval-app)))) (define eval-app (make-clsr:eval-app (lambda () evaluate))) - (define closure-tests-suite + (define define-closure-tests (test-suite "Tests for closure.ss" diff --git a/collects/web-server/tests/test-post-patch.ss b/collects/web-server/tests/private/request-test.ss similarity index 92% rename from collects/web-server/tests/test-post-patch.ss rename to collects/web-server/tests/private/request-test.ss index 2ab3e425c5..04b0a86d82 100644 --- a/collects/web-server/tests/test-post-patch.ss +++ b/collects/web-server/tests/private/request-test.ss @@ -1,7 +1,6 @@ -(module test-post-patch mzscheme +(module request-test mzscheme (require (planet "util.ss" ("schematics" "schemeunit.plt" 2)) (planet "test.ss" ("schematics" "schemeunit.plt" 2)) - (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2)) (lib "connection-structs.ss" "web-server" "private") (lib "timer-structs.ss" "web-server" "private") (lib "request-structs.ss" "web-server" "private")) @@ -37,7 +36,7 @@ (lambda (f s) s))) - (define binding-parse-tests + (define request-tests (test-suite "tests for parsing bindings" (test-equal? "simple test 1" @@ -48,4 +47,4 @@ (binding:form-value (bindings-assq #"hello" (get-bindings "hello=world"))) #"world"))) - (test/text-ui binding-parse-tests)) \ No newline at end of file + (provide request-tests)) \ No newline at end of file diff --git a/collects/web-server/tests/servlet-env-test.ss b/collects/web-server/tests/servlet-env-test.ss index 7e80b8ce7b..4cf362d43a 100644 --- a/collects/web-server/tests/servlet-env-test.ss +++ b/collects/web-server/tests/servlet-env-test.ss @@ -1,5 +1,5 @@ (module servlet-env-test mzscheme - (require (lib "servlet-env.ss" "web-server" "tools")) + (require (lib "servlet-env.ss" "web-server")) ; request-number : str -> num (define (request-number which-number) @@ -18,8 +18,10 @@ (input ([type "text"] [name "number"] [value ""])) (input ([type "submit"] [name "enter"] [value "Enter"]))))))) #;(on-web - `(html (head (title "Sum")) - (body ([bgcolor "white"]) - (p "The sum is " - ,(number->string (+ (request-number "first") (request-number "second"))))))) - (on-web 9000 (+ (request-number "first") (request-number "second")))) + `(html (head (title "Sum")) + (body ([bgcolor "white"]) + (p "The sum is " + ,(number->string (+ (request-number "first") (request-number "second"))))))) + + (define (test) + (on-web 9000 (+ (request-number "first") (request-number "second"))))) \ No newline at end of file diff --git a/collects/web-server/tests/suite.ss b/collects/web-server/tests/suite.ss deleted file mode 100644 index 7c93c724e7..0000000000 --- a/collects/web-server/tests/suite.ss +++ /dev/null @@ -1,25 +0,0 @@ -(module suite mzscheme - (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" - "labels-tests.ss" - "lang-tests.ss" - "certify-tests.ss" - "stuff-url-tests.ss" - "param-tests.ss") - - (test/graphical-ui - (test-suite - "Main Tests for Prototype Web Server" - persistent-close-suite - stuff-url-suite - anormal-tests - closure-tests-suite - labels-tests-suite - lang-suite - certify-suite - param-suite - ))) \ No newline at end of file