From 54429dc56b7d5283461cc1d16acc7e65b41feee7 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Mon, 17 Nov 2008 17:07:51 +0000 Subject: [PATCH] Response/basic bug svn: r12474 --- .../tests/web-server/private/response-test.ss | 38 ++++++++++++++++++- collects/web-server/http/response.ss | 10 +++++ 2 files changed, 47 insertions(+), 1 deletion(-) diff --git a/collects/tests/web-server/private/response-test.ss b/collects/tests/web-server/private/response-test.ss index 325124ec48..89b09e6892 100644 --- a/collects/tests/web-server/private/response-test.ss +++ b/collects/tests/web-server/private/response-test.ss @@ -28,6 +28,34 @@ (test-suite "output-response" + (test-suite + "response/basic" + (test-equal? "response/basic" + (output output-response + (make-response/basic 404 "404" (current-seconds) #"text/html" + (list))) + #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nContent-Length: 0\r\n\r\n") + (test-equal? "response/basic (header)" + (output output-response + (make-response/basic 404 "404" (current-seconds) #"text/html" + (list (make-header #"Header" #"Value")))) + #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nContent-Length: 0\r\nHeader: Value\r\n\r\n") + (test-equal? "response/basic (body)" + (output output-response + (make-response/basic 404 "404" (current-seconds) #"text/html" + (list))) + #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nContent-Length: 0\r\n\r\n") + (test-equal? "response/basic (bytes body)" + (output output-response + (make-response/basic 404 "404" (current-seconds) #"text/html" + (list))) + #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nContent-Length: 0\r\n\r\n") + (test-equal? "response/basic (both)" + (output output-response + (make-response/basic 404 "404" (current-seconds) #"text/html" + (list (make-header #"Header" #"Value")))) + #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nContent-Length: 0\r\nHeader: Value\r\n\r\n")) + (test-suite "response/full" (test-equal? "response/full" @@ -55,6 +83,7 @@ (make-response/full 404 "404" (current-seconds) #"text/html" (list (make-header #"Header" #"Value")) (list "Content!"))) #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED 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" @@ -94,6 +123,7 @@ (write "Content!") (write "Content!")))) #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED 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" @@ -108,14 +138,17 @@ (output output-response (list #"text/html" #"Content")) #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED 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: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html; charset=utf-8\r\nContent-Length: 65\r\n\r\nHey!Content"))) + #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html; charset=utf-8\r\nContent-Length: 65\r\n\r\nHey!Content")) + ) (test-suite "output-response/method" + (test-suite "response/full" (test-equal? "response/full" @@ -148,6 +181,7 @@ (list (make-header #"Header" #"Value")) (list "Content!")) 'head) #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nContent-Length: 8\r\nHeader: Value\r\n\r\n")) + (test-suite "response/incremental" (test-equal? "response/incremental" @@ -193,6 +227,7 @@ (write "Content!"))) 'head) #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nTransfer-Encoding: chunked\r\nHeader: Value\r\n\r\n")) + (test-suite "Simple content" (test-equal? "empty" @@ -210,6 +245,7 @@ (list #"text/html" #"Content") 'head) #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: PLT Scheme\r\nContent-Type: text/html\r\nContent-Length: 7\r\n\r\n")) + (test-suite "xexpr" (test-equal? "any" diff --git a/collects/web-server/http/response.ss b/collects/web-server/http/response.ss index 53bda2d7e2..dfb26db3c0 100644 --- a/collects/web-server/http/response.ss +++ b/collects/web-server/http/response.ss @@ -86,6 +86,16 @@ (list* (make-header #"Transfer-Encoding" #"chunked") (response/basic-headers resp)) (response/incremental-generator resp)))] + [(response/basic? resp) + (response->response/basic + close? + (make-response/full + (response/basic-code resp) + (response/basic-message resp) + (response/basic-seconds resp) + (response/basic-mime resp) + (response/basic-headers resp) + empty))] [(and (pair? resp) (bytes? (car resp))) (response->response/basic close?