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

Adding test suite

Browse Source 
svn: r6399
This commit is contained in:
Jay McCarthy 2007-05-30 01:29:32 +00:00
parent c98f7e017b
commit f70d12b1b7
1 changed files with 51 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
collects/web-server/tests/test-post-patch.ss Normal file
View File

@ -0,0 +1,51 @@
(module test-post-patch mzscheme
(require (planet "util.ss" ("schematics" "schemeunit.plt" 2))
(planet "test.ss" ("schematics" "schemeunit.plt" 2))
(planet "text-ui.ss" ("schematics" "schemeunit.plt" 2))
(lib "connection-structs.ss" "web-server" "private")
(lib "timer-structs.ss" "web-server" "private")
(lib "request-structs.ss" "web-server"))
(require/expose (lib "request.ss" "web-server" "private")
(read-bindings&post-data/raw))
;; mock connection object for test on post body parsing
(define (make-mock-connection&headers post-body)
(let* ([bytes (string->bytes/utf-8 post-body)]
[headers (list (make-header
#"Content-Length"
(string->bytes/utf-8
(number->string (bytes-length bytes)))))]
[ip (open-input-bytes bytes)]
[op (open-output-bytes)])
(values (make-connection (make-timer ip +inf.0 (lambda () (void)))
ip
op
(make-custodian)
#f
(make-semaphore))
headers)))
(define (get-bindings post-data)
(define-values (conn headers) (make-mock-connection&headers post-data))
(call-with-values (lambda () (read-bindings&post-data/raw conn 'post #f headers))
(lambda (f s) f)))
(define (get-post-data/raw post-data)
(define-values (conn headers) (make-mock-connection&headers post-data))
(call-with-values (lambda () (read-bindings&post-data/raw conn 'post #f headers))
(lambda (f s) s)))
(define binding-parse-tests
(test-suite
"tests for parsing bindings"
(test-equal? "simple test 1"
(get-post-data/raw "hello world") #"hello world")
(test-equal? "simple test 2"
(get-post-data/raw "hello=world") #"hello=world")
(test-equal? "simple test 3"
(binding:form-value (bindings-assq #"hello" (get-bindings "hello=world")))
#"world")))
(test/text-ui binding-parse-tests))