Tests and bug fixes and notes

svn: r6524

collects/web-server/dispatchers/dispatch-lang.ss

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

collects/web-server/servlet/servlet-url.ss

@@ -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)))
   

collects/web-server/tests/servlet/servlet-url-test.ss

@@ -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")))))