107 lines
4.6 KiB
Scheme
107 lines
4.6 KiB
Scheme
(module dispatch-servlets-test mzscheme
|
|
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
|
(only (planet "ssax.ss" ("lizorkin" "ssax.plt" 1 3))
|
|
ssax:xml->sxml)
|
|
(planet "sxml.ss" ("lizorkin" "sxml.plt" 1 4))
|
|
(lib "etc.ss")
|
|
(lib "url.ss" "net")
|
|
(lib "list.ss")
|
|
(lib "pretty.ss")
|
|
(lib "request-structs.ss" "web-server" "private")
|
|
(lib "cache-table.ss" "web-server" "private")
|
|
(lib "web-server-structs.ss" "web-server" "private")
|
|
(lib "namespace.ss" "web-server" "configuration")
|
|
(prefix servlets: (lib "dispatch-servlets.ss" "web-server" "dispatchers"))
|
|
"../util.ss")
|
|
(provide dispatch-servlets-tests)
|
|
|
|
(current-server-custodian (current-custodian))
|
|
|
|
(define (mkd p)
|
|
(define-values (! d)
|
|
(servlets:make #f (box (make-cache-table)) (make-make-servlet-namespace)
|
|
#:url->path (lambda _ (values p url0s))
|
|
#:responders-servlet-loading
|
|
(lambda (u exn)
|
|
(raise exn))
|
|
#:responders-servlet
|
|
(lambda (u exn)
|
|
(raise exn))))
|
|
d)
|
|
(define url0 "http://test.com/servlets/example.ss")
|
|
(define url0s (list (build-path "servlets") (build-path "example.ss")))
|
|
(define (call d u bs)
|
|
(htxml (collect d (make-request 'get (string->url u) empty bs #"" "127.0.0.1" 80 "127.0.0.1"))))
|
|
(define (htxml bs)
|
|
(define sx (ssax:xml->sxml (open-input-bytes (second (regexp-match #"^.+\r\n\r\n(.+)$" bs))) empty))
|
|
(pretty-print sx)
|
|
sx)
|
|
|
|
(define test-servlets (build-path (collection-path "web-server") "tests" "servlets"))
|
|
(define example-servlets (build-path (collection-path "web-server") "default-web-root" "servlets" "examples/"))
|
|
|
|
(define dispatch-servlets-tests
|
|
(test-suite
|
|
"Servlets"
|
|
|
|
; XXX test update cache
|
|
|
|
(test-pred "configure.ss"
|
|
string?
|
|
(let* ([d (mkd (build-path example-servlets 'up "configure.ss"))]
|
|
[k0 (first ((sxpath "//form/@action/text()") (call d url0 empty)))])
|
|
k0))
|
|
|
|
(test-suite
|
|
"Examples"
|
|
(test-equal? "hello.ss"
|
|
(let* ([d (mkd (build-path example-servlets "hello.ss"))]
|
|
[t0 (first ((sxpath "//p/text()") (call d url0 empty)))])
|
|
t0)
|
|
"Hello, Web!")
|
|
(test-equal? "add.ss"
|
|
(let* ([d (mkd (build-path example-servlets "add.ss"))]
|
|
[k0 (first ((sxpath "//form/@action/text()") (call d url0 empty)))]
|
|
[k1 (first ((sxpath "//form/@action/text()") (call d k0 (list (make-binding:form #"number" #"23")))))]
|
|
[n (first ((sxpath "//p/text()") (call d k1 (list (make-binding:form #"number" #"12")))))])
|
|
n)
|
|
"The sum is 35")
|
|
(test-equal? "count.ss"
|
|
(let* ([d (mkd (build-path example-servlets "count.ss"))]
|
|
[ext (lambda (c)
|
|
(rest (regexp-match #rx"This servlet was called (.+) times and (.+) times since loaded on" c)))]
|
|
[c1 (ext (first ((sxpath "//p/text()") (call d url0 empty))))]
|
|
[c2 (ext (first ((sxpath "//p/text()") (call d url0 empty))))])
|
|
(list c1 c2))
|
|
(list (list "1" "1")
|
|
(list "2" "1")))
|
|
(test-equal? "dir.ss"
|
|
(let* ([d (mkd (build-path example-servlets "dir.ss"))]
|
|
[t0 (first ((sxpath "//p/em/text()") (call d url0 empty)))])
|
|
t0)
|
|
(path->string example-servlets))
|
|
(test-pred "quiz.ss"
|
|
string?
|
|
(let* ([d (mkd (build-path example-servlets "quiz.ss"))])
|
|
(foldl (lambda (_ k)
|
|
(first ((sxpath "//form/@action/text()") (call d k (list (make-binding:form #"answer" #"0"))))))
|
|
url0
|
|
(build-list 7 (lambda (i) i))))))
|
|
|
|
(test-suite
|
|
"servlet/web.ss"
|
|
; XXX current-url-transform
|
|
; XXX current-servlet-continuation-expiration-handler
|
|
; XXX redirect/get
|
|
; XXX redirect/get/forget
|
|
; XXX adjust-timeout!
|
|
; XXX clear-continuation-table!
|
|
; XXX send/back
|
|
; XXX send/finish
|
|
; XXX send/suspend
|
|
; XXX send/forward
|
|
; XXX send/suspend/dispatch
|
|
; XXX send/suspend/callback
|
|
)
|
|
|
|
))) |