124 lines
5.1 KiB
Racket
124 lines
5.1 KiB
Racket
#lang racket/base
|
|
(require rackunit
|
|
mzlib/etc
|
|
mzlib/list
|
|
xml
|
|
web-server/http
|
|
web-server/private/cache-table
|
|
web-server/private/web-server-structs
|
|
web-server/configuration/namespace
|
|
web-server/servlet/setup
|
|
(prefix-in servlets: web-server/dispatchers/dispatch-servlets)
|
|
"servlet-test-util.rkt"
|
|
"../util.rkt")
|
|
(provide dispatch-servlets-tests)
|
|
|
|
(current-server-custodian (current-custodian))
|
|
|
|
(define (mkd p)
|
|
(define-values (! u->s)
|
|
(servlets:make-cached-url->servlet
|
|
(lambda _ (values p url0s))
|
|
(make-default-path->servlet)))
|
|
(define d
|
|
(servlets:make u->s
|
|
#:responders-servlet-loading
|
|
(lambda (u exn)
|
|
(raise exn))
|
|
#:responders-servlet
|
|
(lambda (u exn)
|
|
(raise exn))))
|
|
d)
|
|
|
|
(define example-servlets
|
|
(build-path (collection-path "web-server") "default-web-root" "htdocs" "servlets" "examples/"))
|
|
|
|
(define dispatch-servlets-tests
|
|
(test-suite
|
|
"Servlets"
|
|
|
|
; XXX test update cache
|
|
; XXX redirect/get
|
|
; XXX web-cells
|
|
|
|
(test-pred "configure.rkt"
|
|
string?
|
|
(let* ([d (mkd (build-path example-servlets 'up "configure.rkt"))]
|
|
[k0 (simple-xpath* '(form #:action) (call d url0 empty))])
|
|
k0))
|
|
|
|
(test-suite
|
|
"Examples"
|
|
(test-equal? "hello.rkt - loading"
|
|
(let* ([d (mkd (build-path example-servlets "hello.rkt"))]
|
|
[t0 (simple-xpath* '(p) (call d url0 empty))])
|
|
t0)
|
|
"Hello, Web!")
|
|
(test-equal? "response.rktd - loading"
|
|
(parameterize ([xexpr-drop-empty-attributes #t])
|
|
(let* ([d (mkd (build-path example-servlets "response.rktd"))])
|
|
(call d url0 empty)))
|
|
`(html (head (title "Hello"))
|
|
(body ([bgcolor "white"])
|
|
(p "Hello"))))
|
|
(test-add-two-numbers mkd "add.rkt - send/suspend"
|
|
(build-path example-servlets "add.rkt"))
|
|
(test-add-two-numbers mkd "add-v2.rkt - send/suspend, version 2"
|
|
(build-path example-servlets "add-v2.rkt"))
|
|
(test-add-two-numbers mkd "add-ssd.rkt - send/suspend/dispatch"
|
|
(build-path example-servlets "add-ssd.rkt"))
|
|
(test-add-two-numbers mkd "add-formlets.rkt - send/formlet"
|
|
(build-path example-servlets "add-formlets.rkt"))
|
|
(test-equal? "count.rkt - state"
|
|
(let* ([d (mkd (build-path example-servlets "count.rkt"))]
|
|
[ext (lambda (c)
|
|
(rest (regexp-match #rx"This servlet was called (.+) times and (.+) times since loaded on" c)))]
|
|
[c1 (ext (simple-xpath* '(p) (call d url0 empty)))]
|
|
[c2 (ext (simple-xpath* '(p) (call d url0 empty)))])
|
|
(list c1 c2))
|
|
(list (list "1" "1")
|
|
(list "2" "1")))
|
|
(test-equal? "dir.rkt - current-directory"
|
|
(let* ([d (mkd (build-path example-servlets "dir.rkt"))]
|
|
[t0 (simple-xpath* '(p em) (call d url0 empty))])
|
|
t0)
|
|
(path->string example-servlets))
|
|
(test-pred "quiz.rkt - send/suspend"
|
|
string?
|
|
(let* ([d (mkd (build-path example-servlets "quiz.rkt"))])
|
|
(foldl (lambda (_ k)
|
|
(simple-xpath* '(form #:action) (call d k (list (make-binding:form #"answer" #"0")))))
|
|
url0
|
|
(build-list 7 (lambda (i) i)))))
|
|
(test-equal? "clear.rkt - current-servlet-continuation-expiration-handler, clear-continuation-table!, send/finish, send/forward"
|
|
(let* ([d (mkd (build-path example-servlets "clear.rkt"))]
|
|
[k0 (simple-xpath* '(a #:href) (call d url0 empty))]
|
|
[k1 (simple-xpath* '(a #:href) (call d k0 empty))]
|
|
[k0-expired (simple-xpath* '(body) (call d k0 empty))]
|
|
[done (simple-xpath* '(body) (call d k1 empty))]
|
|
[k1-expired (simple-xpath* '(body) (call d k1 empty))])
|
|
(list k0-expired
|
|
done
|
|
k1-expired))
|
|
(list "Expired"
|
|
"Done."
|
|
"Expired"))
|
|
|
|
(test-double-counters
|
|
mkd
|
|
"wc-fake.rkt - no cells"
|
|
(build-path example-servlets "wc-fake.rkt"))
|
|
|
|
(test-double-counters
|
|
mkd
|
|
"wc.rkt - make-web-cell web-cell-ref web-cell-shadow"
|
|
(build-path example-servlets "wc.rkt"))
|
|
|
|
; XXX Broken
|
|
#;(test-equal? "adjust.rkt - adjust-timeout!"
|
|
(let* ([d (mkd (build-path example-servlets "adjust.rkt"))]
|
|
[k0 (first ((sxpath "//a/@href/text()") (call d url0 empty)))])
|
|
(sleep 3)
|
|
(call d k0 empty))
|
|
"#"))))
|