summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Hartwig <mandyke@gmail.com>2013-02-23 15:15:33 +0800
committerDaniel Hartwig <mandyke@gmail.com>2013-03-16 17:56:08 +0800
commit2e08ff38b735020e8ed5403acb637e6041d3d743 (patch)
tree78fd5447753d32b7bd5270cec1d0358b4ffb9d00
parentdc8712611597c6d5be918a69b0ce719e0675f6fe (diff)
downloadguile-2e08ff38b735020e8ed5403acb637e6041d3d743.tar.gz
add tests for read-request-line, etc.
* test-suite/web/web-http.test ("read-request-line"): ("write-request-line", "read-response-line", "write-response-line"): Add.
-rw-r--r--test-suite/tests/web-http.test107
1 files changed, 107 insertions, 0 deletions
diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test
index 97f55594a..6fa16bd4c 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -85,6 +85,113 @@
#t
(error "unexpected exception" component arg))))))))
+(define-syntax pass-if-read-request-line
+ (syntax-rules ()
+ ((_ str expected-method expected-uri expected-version)
+ (pass-if str
+ (equal? (call-with-values
+ (lambda ()
+ (read-request-line (open-input-string
+ (string-append str "\r\n"))))
+ list)
+ (list 'expected-method
+ expected-uri
+ 'expected-version))))))
+
+(define-syntax pass-if-write-request-line
+ (syntax-rules ()
+ ((_ expected-str method uri version)
+ (pass-if expected-str
+ (equal? (string-append expected-str "\r\n")
+ (call-with-output-string
+ (lambda (port)
+ (write-request-line 'method uri 'version port))))))))
+
+(define-syntax pass-if-read-response-line
+ (syntax-rules ()
+ ((_ str expected-version expected-code expected-phrase)
+ (pass-if str
+ (equal? (call-with-values
+ (lambda ()
+ (read-response-line (open-input-string
+ (string-append str "\r\n"))))
+ list)
+ (list 'expected-version
+ expected-code
+ expected-phrase))))))
+
+(define-syntax pass-if-write-response-line
+ (syntax-rules ()
+ ((_ expected-str version code phrase)
+ (pass-if expected-str
+ (equal? (string-append expected-str "\r\n")
+ (call-with-output-string
+ (lambda (port)
+ (write-response-line 'version code phrase port))))))))
+
+(with-test-prefix "read-request-line"
+ (pass-if-read-request-line "GET / HTTP/1.1"
+ GET
+ (build-uri 'http
+ #:path "/")
+ (1 . 1))
+ (pass-if-read-request-line "GET http://www.w3.org/pub/WWW/TheProject.html HTTP/1.1"
+ GET
+ (build-uri 'http
+ #:host "www.w3.org"
+ #:path "/pub/WWW/TheProject.html")
+ (1 . 1))
+ (pass-if-read-request-line "GET /pub/WWW/TheProject.html HTTP/1.1"
+ GET
+ (build-uri 'http
+ #:path "/pub/WWW/TheProject.html")
+ (1 . 1))
+ (pass-if-read-request-line "HEAD /etc/hosts?foo=bar HTTP/1.1"
+ HEAD
+ (build-uri 'http
+ #:path "/etc/hosts"
+ #:query "foo=bar")
+ (1 . 1)))
+
+(with-test-prefix "write-request-line"
+ (pass-if-write-request-line "GET / HTTP/1.1"
+ GET
+ (build-uri 'http
+ #:path "/")
+ (1 . 1))
+ ;;; FIXME: Test fails due to scheme, host always being removed.
+ ;;; However, it should be supported to request these be present, and
+ ;;; that is possible with absolute/relative URI support.
+ ;; (pass-if-write-request-line "GET http://www.w3.org/pub/WWW/TheProject.html HTTP/1.1"
+ ;; GET
+ ;; (build-uri 'http
+ ;; #:host "www.w3.org"
+ ;; #:path "/pub/WWW/TheProject.html")
+ ;; (1 . 1))
+ (pass-if-write-request-line "GET /pub/WWW/TheProject.html HTTP/1.1"
+ GET
+ (build-uri 'http
+ #:path "/pub/WWW/TheProject.html")
+ (1 . 1))
+ (pass-if-write-request-line "HEAD /etc/hosts?foo=bar HTTP/1.1"
+ HEAD
+ (build-uri 'http
+ #:path "/etc/hosts"
+ #:query "foo=bar")
+ (1 . 1)))
+
+(with-test-prefix "read-response-line"
+ (pass-if-read-response-line "HTTP/1.0 404 Not Found"
+ (1 . 0) 404 "Not Found")
+ (pass-if-read-response-line "HTTP/1.1 200 OK"
+ (1 . 1) 200 "OK"))
+
+(with-test-prefix "write-response-line"
+ (pass-if-write-response-line "HTTP/1.0 404 Not Found"
+ (1 . 0) 404 "Not Found")
+ (pass-if-write-response-line "HTTP/1.1 200 OK"
+ (1 . 1) 200 "OK"))
+
(with-test-prefix "general headers"
(pass-if-parse cache-control "no-transform" '(no-transform))