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

More Tests

Browse Source 
svn: r6603
This commit is contained in:
Jay McCarthy 2007-06-12 21:28:42 +00:00
parent 394f654acb
commit ef2d83fa3a
2 changed files with 44 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
collects/web-server/tests/dispatchers/dispatch-lang-test.ss
View File

@ -3,6 +3,7 @@
(planet "sxml.ss" ("lizorkin" "sxml.plt" 1 4))
(lib "etc.ss")
(lib "list.ss")
(lib "dispatch.ss" "web-server" "dispatchers")
(lib "request-structs.ss" "web-server" "private")
(lib "namespace.ss" "web-server" "configuration")
(prefix lang: (lib "dispatch-lang.ss" "web-server" "dispatchers"))
@ -71,9 +72,19 @@
(test-suite
"Web Language"
(test-add-two-numbers
(test-exn
"add-param.ss - Parameters, s/s/u (should fail)"
(build-path example-servlets "add-param.ss"))
exn:dispatcher?
(lambda ()
(let* ([xs #"10"]
[ys #"17"]
[d (mkd (build-path example-servlets "add-param.ss"))]
[k0 (first ((sxpath "//form/@action/text()") (call d url0 empty)))]
[k1 (first ((sxpath "//form/@action/text()") (call d (format "~a?number=~a" k0 xs)
(list (make-binding:form #"number" xs)))))]
[n (first ((sxpath "//p/text()") (call d (format "~a?number=~a" k1 ys)
(list (make-binding:form #"number" ys)))))])
n)))
(test-add-two-numbers
"add-simple.ss - Web Parameters, s/s/u"
@ -83,7 +94,6 @@
"add.ss - s/s/u"
(build-path example-servlets "add.ss"))
; XXX
(let* ([x (random 500)]
[xs (string->bytes/utf-8 (number->string x))]
[y (random 500)]
@ -92,18 +102,18 @@
"add01.ss - no s/s, uri"
(let* ([d (mkd (build-path example-servlets "add01.ss"))]
[k0 (first ((sxpath "//form/@action/text()") (call d url0 empty)))]
[k1 (first ((sxpath "//form/@action/text()") (call d (format "~a?first=~a" k0 xs) (list (make-binding:form #"first" xs)))))]
[n (first ((sxpath "//p/text()") (call d (format "~a?first=~a&second=~a" k1 xs ys)
[k1 (first ((sxpath "//form/@action/text()") (call d (format "~a?first=~a" url0 xs) (list (make-binding:form #"first" xs)))))]
[n (first ((sxpath "//p/text()") (call d (format "~a?first=~a&second=~a" url0 xs ys)
(list (make-binding:form #"first" xs)
(make-binding:form #"second" ys)))))])
n)
(format "The answer is ~a" (+ x y))))
(format "The answer is: ~a" (+ x y))))
(test-add-two-numbers
"add02.ss - s/s/u, uri"
(build-path example-servlets "add02.ss"))
; XXX
; XXX Use kont
(test-add-two-numbers
"add03.ss - s/s/h"
(build-path example-servlets "add03.ss"))
@ -139,7 +149,26 @@
t0)
(format "The current directory: ~a" (path->string example-servlets)))
; XXX Use kont
(test-equal? "quiz01.ss"
(let* ([d (mkd (build-path example-servlets "quiz01.ss"))]
[last
(foldl (lambda (_ k)
(first ((sxpath "//form/@action/text()") (call d k (list (make-binding:form #"answer" #"0"))))))
url0
(build-list 7 (lambda (i) i)))])
(first ((sxpath "//h1/text()") (call d last (list (make-binding:form #"answer" #"0"))))))
"Quiz Results")
; XXX Use kont
(test-equal? "quiz02.ss"
(let* ([d (mkd (build-path example-servlets "quiz02.ss"))]
[last
(foldl (lambda (_ k)
(first ((sxpath "//form/@action/text()") (call d k (list (make-binding:form #"answer" #"0"))))))
url0
(build-list 7 (lambda (i) i)))])
(first ((sxpath "//h1/text()") (call d last (list (make-binding:form #"answer" #"0"))))))
"Quiz Results")
; XXX test web-extras.ss - redirect/get
; XXX test web-cells.ss - web-cell?
; XXX test quiz-lib.ss quiz01.ss quiz02.ss
)))

2
collects/web-server/tests/util.ss
View File

@ -31,7 +31,7 @@
(define ip (open-input-bytes ib))
(define op (open-output-bytes))
(values (make-connection (make-timer never-evt +inf.0 (lambda () (void)))
ip op (make-custodian) #f (make-semaphore 1))
ip op (current-custodian) #f (make-semaphore 1))
ip
op))