Adding tests and making comment in docs

svn: r6532

collects/web-server/docs/reference/servlet.scrbl

@@ -340,6 +340,14 @@ servlet developer.
  translated into lowercase symbols.
 }                                           
                                            
+These functions, while convenient, could introduce subtle bugs in your
+application. Examples: the fact they are case-insensitive could introduce
+a bug; if the data submitted is not in UTF-8 format, then the conversion
+to a string will fail; if an attacked submits a form field as if it were
+a file, when it is not, then the @scheme[request-bindings] will hold a
+@scheme[bytes?] object and your program will error; and, for file uploads
+you lose the filename.
+
 @; XXX Move into http/response.ss
 @; XXX Change headers
 @defproc[(redirect-to [uri string?]

collects/web-server/servlet/helpers.ss

@@ -40,9 +40,6 @@
                         (current-seconds) #"text/html"
                         `((Location . ,uri) ,@headers) (list)))
   
-  ; with-errors-to-browser 
-  ; to report exceptions that occur later to the browser
-  ; this must be called at the begining of a servlet
   (define (with-errors-to-browser send/finish-or-back thunk)
     (with-handlers ([exn? (lambda (exn)
                             (send/finish-or-back

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

@@ -1,8 +1,85 @@
 (module helpers-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 "response-structs.ss" "web-server" "private")
+           (lib "request-structs.ss" "web-server" "private")
+           (lib "helpers.ss" "web-server" "servlet"))
   (provide helpers-tests)
   
-  ; XXX
   (define helpers-tests
     (test-suite
-     "Helpers")))
+     "Helpers"
+     
+     (test-suite
+      "with-errors-to-browser"
+      (test-case
+       "Basic"
+       (check-pred list? (with-errors-to-browser (lambda (x) x) (lambda () (error 'error "Hey!")))))
+      (test-case
+       "Basic (succ)"
+       (check-true (with-errors-to-browser (lambda (x) x) (lambda () #t)))))
+     
+     ; XXX Test redirection status
+     ; XXX Test optional headers
+     (test-suite
+      "redirect-to"
+      (test-case
+       "Basic"
+       (check-pred response/full? (redirect-to "http://test.com/foo"))))
+     
+     (test-suite
+      "redirection-status?"
+      (test-case "permanently" (check-true (redirection-status? permanently)))
+      (test-case "temporarily" (check-true (redirection-status? temporarily)))
+      (test-case "see-other" (check-true (redirection-status? see-other))))
+     
+     (test-suite
+      "request-bindings"
+      (test-case
+       "Simple"
+       (check-equal? (request-bindings
+                      (make-request 'get (string->url "http://test.com/foo")
+                                    empty (list (make-binding:form #"key" #"val")) #f
+                                    "host" 80 "client"))
+                     '((key . "val"))))
+      (test-case
+       "Case"
+       (check-equal? (request-bindings
+                      (make-request 'get (string->url "http://test.com/foo")
+                                    empty (list (make-binding:form #"KEY" #"val")) #f
+                                    "host" 80 "client"))
+                     '((key . "val"))))
+      (test-case
+       "Multi"
+       (check-equal? (request-bindings
+                      (make-request 'get (string->url "http://test.com/foo")
+                                    empty (list (make-binding:form #"key" #"val")
+                                                (make-binding:form #"key2" #"val")) #f
+                                                                                    "host" 80 "client"))
+                     '((key . "val")
+                       (key2 . "val"))))
+      (test-case
+       "File"
+       (check-equal? (request-bindings
+                      (make-request 'get (string->url "http://test.com/foo")
+                                    empty (list (make-binding:file #"key" #"file" #"val")) #f
+                                    "host" 80 "client"))
+                     '((key . #"val")))))
+     
+     (test-suite
+      "request-headers"
+      (test-case
+       "Simple"
+       (check-equal? (request-headers
+                      (make-request 'get (string->url "http://test.com/foo")
+                                    (list (make-header #"key" #"val")) empty #f
+                                    "host" 80 "client"))
+                     '((key . "val"))))
+      (test-case
+       "Case"
+       (check-equal? (request-headers
+                      (make-request 'get (string->url "http://test.com/foo")
+                                    (list (make-header #"KEY" #"val")) empty #f
+                                    "host" 80 "client"))
+                     '((key . "val"))))))))