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

Standarizing test suite to figure out what needs to be tested

Browse Source 
svn: r6448
This commit is contained in:
Jay McCarthy 2007-06-01 17:15:31 +00:00
parent 6686571f7a
commit 59b3b26939
14 changed files with 114 additions and 122 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

0
collects/web-server/tests/modules/mm00.ss → collects/web-server/default-web-root/htdocs/lang-servlets/mm00.ss
View File

0
collects/web-server/tests/modules/mm01.ss → collects/web-server/default-web-root/htdocs/lang-servlets/mm01.ss
View File

25
collects/web-server/tests/all-web-server-tests.ss Normal file
View File

@ -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)))

54
collects/web-server/tests/certify-tests.ss
View File

@ -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)))))))

9
collects/web-server/tests/persistent-close-tests.ss → collects/web-server/tests/graveyard/persistent-close-test.ss
View File

@ -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"

55
collects/web-server/tests/lang-tests.ss → collects/web-server/tests/lang-test.ss
View File

@ -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"

4
collects/web-server/tests/anormal-test.ss → collects/web-server/tests/lang/anormal-test.ss
View File

@ -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)

14
collects/web-server/tests/labels-tests.ss → collects/web-server/tests/lang/labels-test.ss
View File

@ -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"

13
collects/web-server/tests/stuff-url-tests.ss → collects/web-server/tests/lang/stuff-url-test.ss
View File

@ -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"

8
collects/web-server/tests/param-tests.ss → collects/web-server/tests/lang/web-param-test.ss
View File

@ -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"

8
collects/web-server/tests/closure-tests.ss → collects/web-server/tests/private/define-closure-test.ss
View File

@ -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"

7
collects/web-server/tests/test-post-patch.ss → collects/web-server/tests/private/request-test.ss
View File

@ -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))
(provide request-tests))

14
collects/web-server/tests/servlet-env-test.ss
View File

@ -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")))))

25
collects/web-server/tests/suite.ss
View File

@ -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
)))