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

Repairing tests

Browse Source
This commit is contained in:
Jay McCarthy 2011-07-24 16:18:24 -04:00
parent bc5846d40e
commit 75631c6f2a
5 changed files with 113 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/web-server/formlets-test.rkt
View File

@ -658,5 +658,3 @@
)) ))
(require rackunit/text-ui)
(run-tests all-formlets-tests)

12
collects/tests/web-server/private/define-closure-test.rkt
View File

@ -55,11 +55,11 @@
(test-case (test-case
"serialize id procedure" "serialize id procedure"
(check = 7 ((deserialize (serialize (make-id))) 7))) (check = 7 ((deserialize (serialize (make-id (lambda () (values))))) 7)))
(test-case (test-case
"id procedure" "id procedure"
(check = 7 ((make-id) 7))) (check = 7 ((make-id (lambda () (values))) 7)))
(test-case (test-case
"add-y procedure" "add-y procedure"
@ -79,21 +79,21 @@
(test-case (test-case
"simple interpreter case" "simple interpreter case"
(check = 3 (evaluate 3 (make-the-empty-env)))) (check = 3 (evaluate 3 (make-the-empty-env (lambda () (values))))))
(test-case (test-case
"serialize simple interpreter case" "serialize simple interpreter case"
(check = 3 ((deserialize (serialize evaluate)) (check = 3 ((deserialize (serialize evaluate))
3 3
(deserialize (serialize (make-the-empty-env)))))) (deserialize (serialize (make-the-empty-env (lambda () (values))))))))
(test-case (test-case
"apply identity" "apply identity"
(check = 3 (evaluate '((lambda (x) x) 3) (make-the-empty-env)))) (check = 3 (evaluate '((lambda (x) x) 3) (make-the-empty-env (lambda () (values))))))
(test-case (test-case
"serialize environments" "serialize environments"
(let* ([e0 (make-the-empty-env)] (let* ([e0 (make-the-empty-env (lambda () (values)))]
[e1 (make-extended-env (lambda () (values e0 'x 1)))] [e1 (make-extended-env (lambda () (values e0 'x 1)))]
[e2 (make-extended-env (lambda () (values e1 'y 2)))] [e2 (make-extended-env (lambda () (values e1 'y 2)))]
[e3 (make-extended-env (lambda () (values e2 'z 3)))] [e3 (make-extended-env (lambda () (values e2 'z 3)))]

5
collects/tests/web-server/private/request-test.rkt
View File

@ -66,7 +66,8 @@
ip ip
(open-output-bytes) (make-custodian) #f) (open-output-bytes) (make-custodian) #f)
8081 8081
(lambda _ (values "s1" "s2")))))) (lambda _ (values "s1" "s2")))
(void))))
(test-suite (test-suite
"POST Bindings" "POST Bindings"
@ -75,5 +76,5 @@
(test-equal? "simple test 2" (test-equal? "simple test 2"
(get-post-data/raw "hello=world") #"hello=world") (get-post-data/raw "hello=world") #"hello=world")
(test-equal? "simple test 3" (test-equal? "simple test 3"
(binding:form-value (bindings-assq #"hello" (get-bindings "hello=world"))) (binding:form-value (bindings-assq #"hello" (force (get-bindings "hello=world"))))
#"world"))))) #"world")))))

151
collects/tests/web-server/private/response-test.rkt
View File

@ -1,10 +1,12 @@
#lang racket/base #lang racket/base
(require rackunit (require rackunit
racket/port
xml/xml xml/xml
(only-in mzlib/file (only-in mzlib/file
make-temporary-file) make-temporary-file)
web-server/http web-server/http
web-server/http/response web-server/http/response
(prefix-in compat0: web-server/compat/0/http/response-structs)
"../util.rkt") "../util.rkt")
(require/expose web-server/http/response (require/expose web-server/http/response
@ -20,57 +22,60 @@
(apply f c any) (apply f c any)
(redact (get-output-bytes o))) (redact (get-output-bytes o)))
(define-syntax-rule (test-equi? t a e)
(test-equal? t (bytes-sort a) (bytes-sort e)))
(define output-response-tests (define output-response-tests
(test-suite (test-suite
"output-response" "output-response"
(test-suite (test-suite
"response" "response"
(test-equal? "response" (test-equi? "response"
(output output-response (output output-response
(response 404 #"404" (current-seconds) #"text/html" (response 404 #"404" (current-seconds) #"text/html"
(list) void)) (list) void))
#"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 0\r\n\r\n") #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nConnection: close\r\n\r\n")
(test-equal? "response (header)" (test-equi? "response (header)"
(output output-response (output output-response
(response 404 #"404" (current-seconds) #"text/html" (response 404 #"404" (current-seconds) #"text/html"
(list (make-header #"Header" #"Value")) void)) (list (make-header #"Header" #"Value")) void))
#"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 0\r\nHeader: Value\r\n\r\n") #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nConnection: close\r\nHeader: Value\r\n\r\n")
(test-equal? "response (body)" (test-equi? "response (body)"
(output output-response (output output-response
(response 404 #"404" (current-seconds) #"text/html" (response 404 #"404" (current-seconds) #"text/html"
(list) void)) (list) void))
#"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 0\r\n\r\n") #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nConnection: close\r\n\r\n")
(test-equal? "response (bytes body)" (test-equi? "response (bytes body)"
(output output-response (output output-response
(response 404 #"404" (current-seconds) #"text/html" (response 404 #"404" (current-seconds) #"text/html"
(list) void)) (list) void))
#"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 0\r\n\r\n") #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nConnection: close\r\n\r\n")
(test-equal? "response (both)" (test-equi? "response (both)"
(output output-response (output output-response
(response 404 #"404" (current-seconds) #"text/html" (response 404 #"404" (current-seconds) #"text/html"
(list (make-header #"Header" #"Value")) void)) (list (make-header #"Header" #"Value")) void))
#"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 0\r\nHeader: Value\r\n\r\n")) #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nConnection: close\r\nHeader: Value\r\n\r\n"))
(test-suite (test-suite
"response/full" "response/full"
(test-equal? "response/full" (test-equi? "response/full"
(output output-response (output output-response
(response/full 404 #"404" (current-seconds) #"text/html" (response/full 404 #"404" (current-seconds) #"text/html"
(list) (list))) (list) (list)))
#"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 0\r\n\r\n") #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 0\r\n\r\n")
(test-equal? "response/full (header)" (test-equi? "response/full (header)"
(output output-response (output output-response
(response/full 404 #"404" (current-seconds) #"text/html" (response/full 404 #"404" (current-seconds) #"text/html"
(list (make-header #"Header" #"Value")) (list))) (list (make-header #"Header" #"Value")) (list)))
#"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 0\r\nHeader: Value\r\n\r\n") #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 0\r\nHeader: Value\r\n\r\n")
(test-equal? "response/full (bytes body)" (test-equi? "response/full (bytes body)"
(output output-response (output output-response
(response/full 404 #"404" (current-seconds) #"text/html" (response/full 404 #"404" (current-seconds) #"text/html"
(list) (list #"Content!"))) (list) (list #"Content!")))
#"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 8\r\n\r\nContent!") #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 8\r\n\r\nContent!")
(test-equal? "response/full (both)" (test-equi? "response/full (both)"
(output output-response (output output-response
(response/full 404 #"404" (current-seconds) #"text/html" (response/full 404 #"404" (current-seconds) #"text/html"
(list (make-header #"Header" #"Value")) (list #"Content!"))) (list (make-header #"Header" #"Value")) (list #"Content!")))
@ -78,25 +83,25 @@
(test-suite (test-suite
"Simple content" "Simple content"
(test-equal? "empty" (test-equi? "empty"
(output output-response (output output-response
(list #"text/html")) (compat0:normalize-response (list #"text/html")))
#"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 0\r\n\r\n") #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 0\r\n\r\n")
(test-equal? "not" (test-equi? "not"
(output output-response (output output-response
(list #"text/html" "Content")) (compat0:normalize-response (list #"text/html" "Content")))
#"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 7\r\n\r\nContent") #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 7\r\n\r\nContent")
(test-equal? "not, bytes" (test-equi? "not, bytes"
(output output-response (output output-response
(list #"text/html" #"Content")) (compat0:normalize-response (list #"text/html" #"Content")))
#"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 7\r\n\r\nContent")) #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 7\r\n\r\nContent"))
(test-suite (test-suite
"xexpr" "xexpr"
(test-equal? "any" (test-equi? "any"
(output output-response (output output-response
`(html (head (title "Hey!")) (body "Content"))) (response/xexpr `(html (head (title "Hey!")) (body "Content"))))
#"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nContent-Length: 65\r\n\r\n<html><head><title>Hey!</title></head><body>Content</body></html>")) #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nConnection: close\r\n\r\n<html><head><title>Hey!</title></head><body>Content</body></html>"))
)) ))
(define output-response/method-tests (define output-response/method-tests
@ -105,31 +110,31 @@
(test-suite (test-suite
"response/full" "response/full"
(test-equal? "response/full" (test-equi? "response/full"
(output output-response/method (output output-response/method
(response/full 404 #"404" (current-seconds) #"text/html" (response/full 404 #"404" (current-seconds) #"text/html"
(list) (list)) (list) (list))
#"HEAD") #"HEAD")
#"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 0\r\n\r\n") #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 0\r\n\r\n")
(test-equal? "response/full (header)" (test-equi? "response/full (header)"
(output output-response/method (output output-response/method
(response/full 404 #"404" (current-seconds) #"text/html" (response/full 404 #"404" (current-seconds) #"text/html"
(list (make-header #"Header" #"Value")) (list)) (list (make-header #"Header" #"Value")) (list))
#"HEAD") #"HEAD")
#"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 0\r\nHeader: Value\r\n\r\n") #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 0\r\nHeader: Value\r\n\r\n")
(test-equal? "response/full (body)" (test-equi? "response/full (body)"
(output output-response/method (output output-response/method
(response/full 404 #"404" (current-seconds) #"text/html" (response/full 404 #"404" (current-seconds) #"text/html"
(list) (list #"Content!")) (list) (list #"Content!"))
#"HEAD") #"HEAD")
#"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 8\r\n\r\n") #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 8\r\n\r\n")
(test-equal? "response/full (bytes body)" (test-equi? "response/full (bytes body)"
(output output-response/method (output output-response/method
(response/full 404 #"404" (current-seconds) #"text/html" (response/full 404 #"404" (current-seconds) #"text/html"
(list) (list #"Content!")) (list) (list #"Content!"))
#"HEAD") #"HEAD")
#"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 8\r\n\r\n") #"HTTP/1.1 404 404\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 8\r\n\r\n")
(test-equal? "response/full (both)" (test-equi? "response/full (both)"
(output output-response/method (output output-response/method
(response/full 404 #"404" (current-seconds) #"text/html" (response/full 404 #"404" (current-seconds) #"text/html"
(list (make-header #"Header" #"Value")) (list #"Content!")) (list (make-header #"Header" #"Value")) (list #"Content!"))
@ -138,29 +143,29 @@
(test-suite (test-suite
"Simple content" "Simple content"
(test-equal? "empty" (test-equi? "empty"
(output output-response/method (output output-response/method
(list #"text/html") (compat0:normalize-response (list #"text/html"))
#"HEAD") #"HEAD")
#"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 0\r\n\r\n") #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 0\r\n\r\n")
(test-equal? "not" (test-equi? "not"
(output output-response/method (output output-response/method
(list #"text/html" #"Content") (compat0:normalize-response (list #"text/html" #"Content"))
#"HEAD") #"HEAD")
#"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 7\r\n\r\n") #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 7\r\n\r\n")
(test-equal? "not, bytes" (test-equi? "not, bytes"
(output output-response/method (output output-response/method
(list #"text/html" #"Content") (compat0:normalize-response (list #"text/html" #"Content"))
#"HEAD") #"HEAD")
#"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 7\r\n\r\n")) #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nContent-Length: 7\r\n\r\n"))
(test-suite (test-suite
"xexpr" "xexpr"
(test-equal? "any" (test-equi? "any"
(output output-response/method (output output-response/method
`(html (head (title "Hey!")) (body "Content")) (response/xexpr `(html (head (title "Hey!")) (body "Content")))
#"HEAD") #"HEAD")
#"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nContent-Length: 65\r\n\r\n")))) #"HTTP/1.1 200 Okay\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html; charset=utf-8\r\nConnection: close\r\n\r\n"))))
(define response-tests (define response-tests
(test-suite (test-suite
@ -185,81 +190,109 @@
(convert-http-ranges (convert-http-ranges
'((10 . #f) (20 . 30) (#f . 40) (40 . 60) (49 . 60)) '((10 . #f) (20 . 30) (#f . 40) (40 . 60) (49 . 60))
50) 50)
'((10 . 50) (20 . 31) (10 . 50) (40 . 50))) '((10 . 50) (20 . 31) (10 . 50) (40 . 50) (49 . 50)))
(test-suite (test-suite
"output-file" "output-file"
(test-equal? "(get) whole file - no Range header" (test-equi? "(get) whole file - no Range header"
(output output-file tmp-file #"GET" #"text/html" #f) (output output-file tmp-file #"GET" #"text/html" #f)
#"HTTP/1.1 200 OK\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\n\r\n<html><head><title>A title</title></head><body>Here's some content!</body></html>") #"HTTP/1.1 200 OK\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\n\r\n<html><head><title>A title</title></head><body>Here's some content!</body></html>")
(test-equal? "(get) whole file - Range header present" (test-equi? "(get) whole file - Range header present"
(output output-file tmp-file #"GET" #"text/html" '((0 . 80))) (output output-file tmp-file #"GET" #"text/html" '((0 . 80)))
#"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\n<html><head><title>A title</title></head><body>Here's some content!</body></html>") #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\n<html><head><title>A title</title></head><body>Here's some content!</body></html>")
(test-equal? "(get) single range - suffix range larger than file" (test-equi? "(get) single range - suffix range larger than file"
(output output-file tmp-file #"GET" #"text/html" '((#f . 90))) (output output-file tmp-file #"GET" #"text/html" '((#f . 90)))
#"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\n<html><head><title>A title</title></head><body>Here's some content!</body></html>") #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\n<html><head><title>A title</title></head><body>Here's some content!</body></html>")
(test-equal? "(get) single range - 10 bytes from the start" (test-equi? "(get) single range - 10 bytes from the start"
(output output-file tmp-file #"GET" #"text/html" '((0 . 9))) (output output-file tmp-file #"GET" #"text/html" '((0 . 9)))
#"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 10\r\nContent-Range: bytes 0-9/81\r\n\r\n<html><hea") #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 10\r\nContent-Range: bytes 0-9/81\r\n\r\n<html><hea")
(test-equal? "(get) single range - 10 bytes from the end" (test-equi? "(get) single range - 10 bytes from the end"
(output output-file tmp-file #"GET" #"text/html" '((71 . #f))) (output output-file tmp-file #"GET" #"text/html" '((71 . #f)))
#"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 10\r\nContent-Range: bytes 71-80/81\r\n\r\ndy></html>") #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 10\r\nContent-Range: bytes 71-80/81\r\n\r\ndy></html>")
(test-equal? "(get) single range - 10 bytes from past the end" (test-equi? "(get) single range - 10 bytes from past the end"
(output output-file tmp-file #"GET" #"text/html" '((76 . 86))) (output output-file tmp-file #"GET" #"text/html" '((76 . 86)))
#"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 5\r\nContent-Range: bytes 76-80/81\r\n\r\nhtml>") #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 5\r\nContent-Range: bytes 76-80/81\r\n\r\nhtml>")
(test-equal? "(get) single range - 10 bytes from the middle" (test-equi? "(get) single range - 10 bytes from the middle"
(output output-file tmp-file #"GET" #"text/html" '((10 . 19))) (output output-file tmp-file #"GET" #"text/html" '((10 . 19)))
#"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 10\r\nContent-Range: bytes 10-19/81\r\n\r\nd><title>A") #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 10\r\nContent-Range: bytes 10-19/81\r\n\r\nd><title>A")
(test-equal? "(get) multiple ranges" (test-equi? "(get) multiple ranges"
(output output-file/boundary tmp-file #"GET" #"text/html" '((10 . 19) (30 . 39) (50 . 59)) #"BOUNDARY") (output output-file/boundary tmp-file #"GET" #"text/html" '((10 . 19) (30 . 39) (50 . 59)) #"BOUNDARY")
#"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: multipart/byteranges; boundary=BOUNDARY\r\nAccept-Ranges: bytes\r\nContent-Length: 260\r\n\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 10-19/81\r\n\r\nd><title>A\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 30-39/81\r\n\r\ntle></head\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 50-59/81\r\n\r\ne's some c\r\n--BOUNDARY--\r\n") #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: multipart/byteranges; boundary=BOUNDARY\r\nAccept-Ranges: bytes\r\nContent-Length: 260\r\n\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 10-19/81\r\n\r\nd><title>A\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 30-39/81\r\n\r\ntle></head\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 50-59/81\r\n\r\ne's some c\r\n--BOUNDARY--\r\n")
(test-equal? "(get) some bad ranges" (test-equi? "(get) some bad ranges"
(output output-file/boundary tmp-file #"GET" #"text/html" '((10 . 19) (1000 . 1050) (30 . 39) (50 . 49)) #"BOUNDARY") (parameterize ([current-error-port (open-output-nowhere)])
(output output-file/boundary tmp-file #"GET" #"text/html" '((10 . 19) (1000 . 1050) (30 . 39) (50 . 49)) #"BOUNDARY"))
#"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: multipart/byteranges; boundary=BOUNDARY\r\nAccept-Ranges: bytes\r\nContent-Length: 178\r\n\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 10-19/81\r\n\r\nd><title>A\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 30-39/81\r\n\r\ntle></head\r\n--BOUNDARY--\r\n") #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: multipart/byteranges; boundary=BOUNDARY\r\nAccept-Ranges: bytes\r\nContent-Length: 178\r\n\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 10-19/81\r\n\r\nd><title>A\r\n--BOUNDARY\r\nContent-Type: text/html\r\nContent-Range: bytes 30-39/81\r\n\r\ntle></head\r\n--BOUNDARY--\r\n")
(test-equal? "(get) all bad ranges" (test-equi? "(get) all bad ranges"
(output output-file/boundary tmp-file #"GET" #"text/html" '((-10 . -5) (1000 . 1050) (50 . 49)) #"BOUNDARY") (parameterize ([current-error-port (open-output-nowhere)])
(output output-file/boundary tmp-file #"GET" #"text/html" '((-10 . -5) (1000 . 1050) (50 . 49)) #"BOUNDARY"))
#"HTTP/1.1 416 Invalid range request\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\n\r\n") #"HTTP/1.1 416 Invalid range request\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\n\r\n")
(test-equal? "(head) whole file - no Range header" (test-equal? "(get) some bad ranges (error)"
(let ()
(define os (open-output-string))
(parameterize ([current-error-port os])
(output output-file/boundary tmp-file #"GET" #"text/html" '((10 . 19) (1000 . 1050) (30 . 39) (50 . 49)) #"BOUNDARY"))
(get-output-string os))
"")
(test-equal? "(get) all bad ranges (error)"
(let ()
(define os (open-output-string))
(parameterize ([current-error-port os])
(output output-file/boundary tmp-file #"GET" #"text/html" '((-10 . -5) (1000 . 1050) (50 . 49)) #"BOUNDARY"))
(get-output-string os))
"convert-http-ranges: No satisfiable ranges in ((-10 . -5) (1000 . 1050) (50 . 49))/81.")
(test-equi? "(head) whole file - no Range header"
(output output-file tmp-file #"HEAD" #"text/html" #f) (output output-file tmp-file #"HEAD" #"text/html" #f)
#"HTTP/1.1 200 OK\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\n\r\n") #"HTTP/1.1 200 OK\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\n\r\n")
(test-equal? "(head) whole file - Range header present" (test-equi? "(head) whole file - Range header present"
(output output-file tmp-file #"HEAD" #"text/html" '((0 . 80))) (output output-file tmp-file #"HEAD" #"text/html" '((0 . 80)))
#"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\n") #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 81\r\nContent-Range: bytes 0-80/81\r\n\r\n")
(test-equal? "(head) single range - 10 bytes from the start" (test-equi? "(head) single range - 10 bytes from the start"
(output output-file tmp-file #"HEAD" #"text/html" '((0 . 9))) (output output-file tmp-file #"HEAD" #"text/html" '((0 . 9)))
#"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 10\r\nContent-Range: bytes 0-9/81\r\n\r\n") #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 10\r\nContent-Range: bytes 0-9/81\r\n\r\n")
(test-equal? "(head) single range - 10 bytes from the end" (test-equi? "(head) single range - 10 bytes from the end"
(output output-file tmp-file #"HEAD" #"text/html" '((71 . #f))) (output output-file tmp-file #"HEAD" #"text/html" '((71 . #f)))
#"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 10\r\nContent-Range: bytes 71-80/81\r\n\r\n") #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 10\r\nContent-Range: bytes 71-80/81\r\n\r\n")
(test-equal? "(head) single range - 10 bytes from the middle" (test-equi? "(head) single range - 10 bytes from the middle"
(output output-file tmp-file #"HEAD" #"text/html" '((10 . 19))) (output output-file tmp-file #"HEAD" #"text/html" '((10 . 19)))
#"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 10\r\nContent-Range: bytes 10-19/81\r\n\r\n") #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\nAccept-Ranges: bytes\r\nContent-Length: 10\r\nContent-Range: bytes 10-19/81\r\n\r\n")
(test-equal? "(head) multiple ranges" (test-equi? "(head) multiple ranges"
(output output-file/boundary tmp-file #"HEAD" #"text/html" '((10 . 19) (30 . 39) (50 . 59)) #"BOUNDARY") (output output-file/boundary tmp-file #"HEAD" #"text/html" '((10 . 19) (30 . 39) (50 . 59)) #"BOUNDARY")
#"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: multipart/byteranges; boundary=BOUNDARY\r\nAccept-Ranges: bytes\r\nContent-Length: 260\r\n\r\n") #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: multipart/byteranges; boundary=BOUNDARY\r\nAccept-Ranges: bytes\r\nContent-Length: 260\r\n\r\n")
(test-equal? "(head) some bad ranges" (test-equi? "(head) some bad ranges"
(output output-file/boundary tmp-file #"HEAD" #"text/html" '((10 . 19) (1000 . 1050) (30 . 39) (50 . 49)) #"BOUNDARY") (output output-file/boundary tmp-file #"HEAD" #"text/html" '((10 . 19) (1000 . 1050) (30 . 39) (50 . 49)) #"BOUNDARY")
#"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: multipart/byteranges; boundary=BOUNDARY\r\nAccept-Ranges: bytes\r\nContent-Length: 178\r\n\r\n") #"HTTP/1.1 206 Partial content\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: multipart/byteranges; boundary=BOUNDARY\r\nAccept-Ranges: bytes\r\nContent-Length: 178\r\n\r\n")
(test-equal? "(head) all bad ranges" (test-equi? "(head) all bad ranges"
(output output-file/boundary tmp-file #"HEAD" #"text/html" '((-10 . -5) (1000 . 1050) (50 . 49)) #"BOUNDARY") (parameterize ([current-error-port (open-output-nowhere)])
(output output-file/boundary tmp-file #"HEAD" #"text/html" '((-10 . -5) (1000 . 1050) (50 . 49)) #"BOUNDARY"))
#"HTTP/1.1 416 Invalid range request\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\n\r\n") #"HTTP/1.1 416 Invalid range request\r\nDate: REDACTED GMT\r\nLast-Modified: REDACTED GMT\r\nServer: Racket\r\nContent-Type: text/html\r\n\r\n")
(test-equal? "(head) all bad ranges"
(let ()
(define os (open-output-string))
(parameterize ([current-error-port os])
(output output-file/boundary tmp-file #"HEAD" #"text/html" '((-10 . -5) (1000 . 1050) (50 . 49)) #"BOUNDARY"))
(get-output-string os))
"convert-http-ranges: No satisfiable ranges in ((-10 . -5) (1000 . 1050) (50 . 49))/81.")
)))) ))))

2
collects/tests/web-server/servlet/helpers-test.rkt
View File

@ -17,7 +17,7 @@
"with-errors-to-browser" "with-errors-to-browser"
(test-case (test-case
"Basic" "Basic"
(check-pred list? (let/ec esc (with-errors-to-browser esc (lambda () (error 'error "Hey!")))))) (check-pred response? (let/ec esc (with-errors-to-browser esc (lambda () (error 'error "Hey!"))))))
(test-case (test-case
"Basic (succ)" "Basic (succ)"
(check-true (let/ec esc (with-errors-to-browser esc (lambda () #t)))))) (check-true (let/ec esc (with-errors-to-browser esc (lambda () #t))))))