58 lines
2.2 KiB
Racket
58 lines
2.2 KiB
Racket
#lang racket/base
|
|
(require web-server/lang/stuff-url
|
|
web-server/stuffers
|
|
rackunit
|
|
net/url
|
|
mzlib/serialize
|
|
"../util.rkt")
|
|
(provide stuff-url-tests)
|
|
|
|
(define uri0 (string->url "www.google.com"))
|
|
|
|
(define test-stuffer serialize-stuffer)
|
|
|
|
(define (stuff-unstuff svl uri)
|
|
(let ([result-uri (stuff-url test-stuffer uri svl)])
|
|
(unstuff-url test-stuffer result-uri)))
|
|
(define (cidentity v)
|
|
(deserialize
|
|
(stuff-unstuff (serialize v) uri0)))
|
|
|
|
(define the-dispatch
|
|
`(lambda (k*v)
|
|
(lambda (k*v)
|
|
((car k*v) k*v))))
|
|
|
|
(define m00 '(lib "mm00.rkt" "web-server" "default-web-root" "htdocs" "lang-servlets"))
|
|
(define m01 '(lib "mm01.rkt" "web-server" "default-web-root" "htdocs" "lang-servlets"))
|
|
|
|
(define stuff-url-tests
|
|
(test-suite
|
|
"Stuff URL"
|
|
|
|
(test-suite
|
|
"(compose unstuff-url stuff-url) is identity"
|
|
(test-case "Integers" (check-equal? (cidentity 3) 3))
|
|
(test-case "Symbols" (check-equal? (cidentity 'foo) 'foo))
|
|
(test-case "Strings" (check-equal? (cidentity "Bar") "Bar"))
|
|
(test-case "Vectors" (check-equal? (cidentity (vector 3 1 4)) (vector 3 1 4))))
|
|
|
|
(test-suite
|
|
"stuffed-url? works"
|
|
(test-case "Not stuffed URL" (check-false (stuffed-url? uri0)))
|
|
(test-case "Integers" (check-true (stuffed-url? (stuff-url test-stuffer uri0 (serialize 3)))))
|
|
(test-case "Symbols" (check-true (stuffed-url? (stuff-url test-stuffer uri0 (serialize 'foo)))))
|
|
(test-case "Strings" (check-true (stuffed-url? (stuff-url test-stuffer uri0 (serialize "Bar")))))
|
|
(test-case "Vectors" (check-true (stuffed-url? (stuff-url test-stuffer uri0 (serialize (vector 3 1 4)))))))
|
|
|
|
(test-case
|
|
"Using stuff-url with lang.rkt"
|
|
(let-values ([(ev) (make-eval/mod-path m00)])
|
|
(let* ([k0 (stuff-unstuff (ev '(serialize (dispatch-start start 'foo)))
|
|
uri0)]
|
|
[k1 (stuff-unstuff (ev `(serialize (dispatch ,the-dispatch (list (deserialize ',k0) 1))))
|
|
uri0)]
|
|
[k2 (stuff-unstuff (ev `(serialize (dispatch ,the-dispatch (list (deserialize ',k1) 2))))
|
|
uri0)])
|
|
(check-true (= 6 (ev `(dispatch ,the-dispatch (list (deserialize ',k2) 3))))))))))
|