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

Tests and bug fixes and notes

Browse Source 
svn: r6524
This commit is contained in:
Jay McCarthy 2007-06-07 21:38:16 +00:00
parent 0338d621eb
commit bdd86a69e4
3 changed files with 30 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/web-server/dispatchers/dispatch-lang.ss
View File

@ -45,7 +45,8 @@
new-path)
empty
#f))
;; XXX url->servlet, get rid of timeout, optional session manager
(define interface-version 'v1)
(define/kw (make #:key
url->path

6
collects/web-server/servlet/servlet-url.ss
View File

@ -14,9 +14,11 @@
(lambda (ps)
(map (lambda (p/p)
(if (unbox first?)
(make-path/param (path/param-path p/p) empty)
(begin0 (make-path/param (path/param-path p/p) empty)
(set-box! first? #f))
p/p))
ps)))))
ps))
in-url)))
(define (request->servlet-url req)
(make-servlet-url (request-uri req)))

27
collects/web-server/tests/servlet/servlet-url-test.ss
View File

@ -1,8 +1,29 @@
(module servlet-url-test mzscheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2)))
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(lib "list.ss")
(lib "url.ss" "net")
(lib "servlet-url.ss" "web-server" "servlet")
(lib "request-structs.ss" "web-server" "private"))
(provide servlet-url-tests)
; XXX
(define servlet-url-tests
(test-suite
"Servlet URLs")))
"Servlet URLs"
(test-case
"Basic"
(check-equal? (servlet-url->url-string/no-continuation
(request->servlet-url
(make-request 'get (string->url "http://localhost/servlets;1*1*65539753/examples/add.ss")
empty empty #f
"host" 80 "client")))
"http://localhost/servlets/examples/add.ss"))
(test-case
"Param"
(check-equal? (servlet-url->url-string/no-continuation
(request->servlet-url
(make-request 'get (string->url "http://localhost/servlets;1*1*65539753/examples/add.ss;foo")
empty empty #f
"host" 80 "client")))
"http://localhost/servlets/examples/add.ss;foo")))))