From 0c73efdbd47d13b027a92d97a52d679507c15b66 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Fri, 8 Jun 2007 00:47:59 +0000 Subject: [PATCH] Basic response tests svn: r6536 --- .../tests/private/connection-manager-test.ss | 6 +- .../web-server/tests/private/request-test.ss | 46 ++++--- .../web-server/tests/private/response-test.ss | 122 +++++++++++++++++- 3 files changed, 151 insertions(+), 23 deletions(-) diff --git a/collects/web-server/tests/private/connection-manager-test.ss b/collects/web-server/tests/private/connection-manager-test.ss index 154ea8052d..bb306a3091 100644 --- a/collects/web-server/tests/private/connection-manager-test.ss +++ b/collects/web-server/tests/private/connection-manager-test.ss @@ -16,7 +16,7 @@ (let ([ib (open-input-bytes #"")] [ob (open-output-bytes)]) (new-connection 1 ib ob (current-custodian) #t) - (sleep 1) + (sleep 2) (with-handlers ([exn? (lambda _ #t)]) (read ib) #f)))) @@ -26,7 +26,7 @@ (let ([ib (open-input-bytes #"")] [ob (open-output-bytes)]) (new-connection 1 ib ob (current-custodian) #t) - (sleep 1) + (sleep 2) (with-handlers ([exn? (lambda _ #t)]) (write 1 ob) #f)))) @@ -49,7 +49,7 @@ [ob (open-output-bytes)] [c (new-connection 1 ib ob (current-custodian) #t)]) (adjust-connection-timeout! c 1) - (sleep 1) + (sleep 2) (and (with-handlers ([exn? (lambda _ #t)]) (read ib) #f) (with-handlers ([exn? (lambda _ #t)]) diff --git a/collects/web-server/tests/private/request-test.ss b/collects/web-server/tests/private/request-test.ss index c693c179da..88f4f13e57 100644 --- a/collects/web-server/tests/private/request-test.ss +++ b/collects/web-server/tests/private/request-test.ss @@ -4,25 +4,22 @@ (lib "connection-manager.ss" "web-server" "private") (lib "timer.ss" "web-server" "private") (lib "request-structs.ss" "web-server" "private")) + (provide request-tests) (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)] + (let* ([b (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)] + (number->string (bytes-length b)))))] + [ip (open-input-bytes b)] [op (open-output-bytes)]) (values (make-connection (make-timer ip +inf.0 (lambda () (void))) - ip - op - (make-custodian) - #f - (make-semaphore)) + ip op (make-custodian) #f (make-semaphore)) headers))) (define (get-bindings post-data) @@ -36,18 +33,31 @@ (lambda (f s) s))) - ; XXX (define request-tests (test-suite "HTTP Requests" + + (test-suite + "Headers" + (test-equal? "Simple" (header-value (headers-assq #"key" (list (make-header #"key" #"val")))) #"val") + (test-false "Not present" (headers-assq #"key" (list))) + (test-equal? "Case" (header-value (headers-assq* #"Key" (list (make-header #"key" #"val")))) #"val")) + (test-suite "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")))) - - (provide request-tests)) \ No newline at end of file + (test-equal? "Simple" (binding:form-value (bindings-assq #"key" (list (make-binding:form #"key" #"val")))) #"val") + (test-equal? "Simple (File)" (binding:file-content (bindings-assq #"key" (list (make-binding:file #"key" #"name" #"val")))) #"val") + (test-false "Not present" (bindings-assq #"key" (list)))) + + ; XXX This needs to be really extensive, see what Apache has + (test-suite + "Parsing" + (test-suite + "POST 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")))))) \ No newline at end of file diff --git a/collects/web-server/tests/private/response-test.ss b/collects/web-server/tests/private/response-test.ss index 1244b3b05f..8fc1963597 100644 --- a/collects/web-server/tests/private/response-test.ss +++ b/collects/web-server/tests/private/response-test.ss @@ -1,8 +1,126 @@ (module response-test mzscheme - (require (planet "test.ss" ("schematics" "schemeunit.plt" 2))) + (require (planet "test.ss" ("schematics" "schemeunit.plt" 2)) + (lib "response.ss" "web-server" "private") + (lib "response-structs.ss" "web-server" "private") + (lib "connection-manager.ss" "web-server" "private") + (lib "timer.ss" "web-server" "private")) (provide response-tests) + (define (make-mock-connection ib) + (define ip (open-input-bytes ib)) + (define op (open-output-bytes)) + (values (make-connection (make-timer never-evt +inf.0 (lambda () (void))) + ip op (make-custodian) #f (make-semaphore 1)) + ip + op)) + + (define (output f . any) + (define-values (c i o) (make-mock-connection #"")) + (apply f c any) + (regexp-replace + #"Date: [a-zA-Z0-9:, ]+ GMT\r\n" + (regexp-replace + #"Last-Modified: [a-zA-Z0-9:, ]+ GMT\r\n" + (get-output-bytes o) + #"Last-Modified: XXX GMT\r\n") + #"Date: XXX GMT\r\n")) + ; XXX (define response-tests (test-suite - "HTTP Responses"))) \ No newline at end of file + "HTTP Responses" + + (test-suite + "output-response" + (test-suite + "response/full" + (test-equal? "response/full" + (output output-response + (make-response/full 404 "404" (current-seconds) #"text/html" + (list) (list))) + #"HTTP/1.1 404 404\r\nDate: XXX GMT\r\nLast-Modified: XXX GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nContent-Length: 0\r\n\r\n") + (test-equal? "response/full (header)" + (output output-response + (make-response/full 404 "404" (current-seconds) #"text/html" + (list (cons 'Header "Value")) (list))) + #"HTTP/1.1 404 404\r\nDate: XXX GMT\r\nLast-Modified: XXX GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nContent-Length: 0\r\nHeader: Value\r\n\r\n") + (test-equal? "response/full (body)" + (output output-response + (make-response/full 404 "404" (current-seconds) #"text/html" + (list) (list "Content!"))) + #"HTTP/1.1 404 404\r\nDate: XXX GMT\r\nLast-Modified: XXX GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nContent-Length: 8\r\n\r\nContent!") + (test-equal? "response/full (bytes body)" + (output output-response + (make-response/full 404 "404" (current-seconds) #"text/html" + (list) (list #"Content!"))) + #"HTTP/1.1 404 404\r\nDate: XXX GMT\r\nLast-Modified: XXX GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nContent-Length: 8\r\n\r\nContent!") + (test-equal? "response/full (both)" + (output output-response + (make-response/full 404 "404" (current-seconds) #"text/html" + (list (cons 'Header "Value")) (list "Content!"))) + #"HTTP/1.1 404 404\r\nDate: XXX GMT\r\nLast-Modified: XXX GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nContent-Length: 8\r\nHeader: Value\r\n\r\nContent!")) + (test-suite + "response/incremental" + (test-equal? "response/incremental" + (output output-response + (make-response/incremental 404 "404" (current-seconds) #"text/html" + (list) (lambda (write) (void)))) + #"HTTP/1.1 404 404\r\nDate: XXX GMT\r\nLast-Modified: XXX GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nTransfer-Encoding: chunked\r\n\r\n0\r\n\r\n") + (test-equal? "response/incremental (header)" + (output output-response + (make-response/incremental 404 "404" (current-seconds) #"text/html" + (list (cons 'Header "Value")) + (lambda (write) (void)))) + #"HTTP/1.1 404 404\r\nDate: XXX GMT\r\nLast-Modified: XXX GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nTransfer-Encoding: chunked\r\nHeader: Value\r\n\r\n0\r\n\r\n") + (test-equal? "response/incremental (body)" + (output output-response + (make-response/incremental 404 "404" (current-seconds) #"text/html" + (list) + (lambda (write) (write "Content!")))) + #"HTTP/1.1 404 404\r\nDate: XXX GMT\r\nLast-Modified: XXX GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nTransfer-Encoding: chunked\r\n\r\n8\r\nContent!\r\n0\r\n\r\n") + (test-equal? "response/incremental (bytes body)" + (output output-response + (make-response/incremental 404 "404" (current-seconds) #"text/html" + (list) + (lambda (write) (write #"Content!")))) + #"HTTP/1.1 404 404\r\nDate: XXX GMT\r\nLast-Modified: XXX GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nTransfer-Encoding: chunked\r\n\r\n8\r\nContent!\r\n0\r\n\r\n") + (test-equal? "response/incremental (both)" + (output output-response + (make-response/incremental 404 "404" (current-seconds) #"text/html" + (list (cons 'Header "Value")) + (lambda (write) (write "Content!")))) + #"HTTP/1.1 404 404\r\nDate: XXX GMT\r\nLast-Modified: XXX GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nTransfer-Encoding: chunked\r\nHeader: Value\r\n\r\n8\r\nContent!\r\n0\r\n\r\n") + (test-equal? "response/incremental (twice)" + (output output-response + (make-response/incremental 404 "404" (current-seconds) #"text/html" + (list (cons 'Header "Value")) + (lambda (write) + (write "Content!") + (write "Content!")))) + #"HTTP/1.1 404 404\r\nDate: XXX GMT\r\nLast-Modified: XXX GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nTransfer-Encoding: chunked\r\nHeader: Value\r\n\r\n8\r\nContent!\r\n8\r\nContent!\r\n0\r\n\r\n")) + (test-suite + "Simple content" + (test-equal? "empty" + (output output-response + (list #"text/html")) + #"HTTP/1.1 200 Okay\r\nDate: XXX GMT\r\nLast-Modified: XXX GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nContent-Length: 0\r\n\r\n") + (test-equal? "not" + (output output-response + (list #"text/html" "Content")) + #"HTTP/1.1 200 Okay\r\nDate: XXX GMT\r\nLast-Modified: XXX GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nContent-Length: 7\r\n\r\nContent") + (test-equal? "not, bytes" + (output output-response + (list #"text/html" #"Content")) + #"HTTP/1.1 200 Okay\r\nDate: XXX GMT\r\nLast-Modified: XXX GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nContent-Length: 7\r\n\r\nContent")) + (test-suite + "xexpr" + (test-equal? "any" + (output output-response + `(html (head (title "Hey!")) (body "Content"))) + #"HTTP/1.1 200 Okay\r\nDate: XXX GMT\r\nLast-Modified: XXX GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html; charset=utf-8\r\nContent-Length: 66\r\n\r\nHey!Content\n"))) + ; XXX + (test-suite + "output-response/method") + ; XXX + (test-suite + "output-file")))) \ No newline at end of file