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

Adding tests and making comment in docs

Browse Source 
svn: r6532
This commit is contained in:
Jay McCarthy 2007-06-07 23:12:03 +00:00
parent d196c0332f
commit eb0711d1b0
3 changed files with 89 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/web-server/docs/reference/servlet.scrbl
View File

@ -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?]

3
collects/web-server/servlet/helpers.ss
View File

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

83
collects/web-server/tests/servlet/helpers-test.ss
View File

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