summaryrefslogtreecommitdiff
path: root/tests/run.scm
diff options
context:
space:
mode:
authorPeter Bex <peter@more-magic.net>2024-09-12 12:15:05 +0200
committerPeter Bex <peter@more-magic.net>2024-09-12 12:15:05 +0200
commit192458eb3c4e1d1a31f9b84ac4b2cca43fdc3e1c (patch)
treee1e72ffcf584b427e163a39bdb66ef46bfd8d3c8 /tests/run.scm
parente3940c300b993bd1256bdff3758d9c421d664ac7 (diff)
downloadintarweb-192458eb3c4e1d1a31f9b84ac4b2cca43fdc3e1c.tar.gz
Update intarweb for CHICKEN 6
This is now using read-bytevector instead of read-string, and the custom port constructor uses keyword arguments now. Don't bother to use cond-expand to make it compatible with C5. Instead, we can cut new C5 releases from the intarweb-2.x branch if necessary.
Diffstat (limited to 'tests/run.scm')
-rw-r--r--tests/run.scm26
1 files changed, 13 insertions, 13 deletions
diff --git a/tests/run.scm b/tests/run.scm
index 95a3990..f6f99ee 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -1,5 +1,5 @@
(import scheme chicken.base chicken.port
- chicken.condition chicken.time.posix srfi-1
+ chicken.condition chicken.time.posix srfi-1
test uri-common intarweb chicken.io chicken.format)
;; Below, there are specific tests for when these do have a value
@@ -138,7 +138,7 @@
(let* ((headers (test-read-headers "Accept-Ranges: FoO")))
(test "Case-insensitive"
'(foo) (header-values 'accept-ranges headers))))
-
+
(test-group "symbol-parser"
(let* ((headers (test-read-headers "Allow: FoO, foo")))
(test "Case-sensitive"
@@ -235,7 +235,7 @@
(test "Custom contents"
'security-through-obscurity
(header-param 'contents 'authorization headers))))))
-
+
(test-group "authenticate parser"
(test-group "basic auth"
(let ((headers (test-read-headers "WWW-Authenticate: Basic realm=\"WallyWorld\"")))
@@ -277,7 +277,7 @@
(test "non-true stale value"
#f
(header-param 'stale 'www-authenticate headers)))))
-
+
(test-group "pragma-parser"
(let ((headers (test-read-headers "Pragma: custom-value=10, no-cache")))
(test "value"
@@ -482,7 +482,7 @@
(header-value 'user-agent (test-read-headers "User-Agent: Mozilla/5.0\r\n")))
(test "Product with comment"
'(("Mozilla" #f "foo"))
- (header-value 'user-agent (test-read-headers "User-Agent: Mozilla (foo)\r\n")))
+ (header-value 'user-agent (test-read-headers "User-Agent: Mozilla (foo)\r\n")))
(test "Realistic product (comments, semicolons)"
'(("Mozilla" "5.0" "X11; U; NetBSD amd64; en-US; rv:1.9.0.3") ("Gecko" "2008110501" #f) ("Minefield" "3.0.3" #f))
(header-value 'user-agent (test-read-headers "User-Agent: Mozilla/5.0 (X11; U; NetBSD amd64; en-US; rv:1.9.0.3) Gecko/2008110501 Minefield/3.0.3\r\n")))
@@ -558,7 +558,7 @@
(utc-time->seconds
(get-param 'expires
(first (header-contents 'set-cookie headers)))))))
-
+
(test-group "cookie-parser"
(let* ((headers (test-read-headers "Cookie: Foo=bar; $Path=/; qux=mooh; $unknown=something")))
(test "Multiple cookies in the same header"
@@ -635,8 +635,8 @@
"Foo: \"bar \\\" qux\", mooh\r\n"
(test-unparse-headers `((foo "bar \" qux" "mooh"))))
(test "Escaping control characters"
- "Foo: \"bar\\\r\\\x01qux\"\r\n"
- (test-unparse-headers `((foo "bar\r\x01qux"))))
+ "Foo: \"bar\\\r\\\x01;qux\"\r\n"
+ (test-unparse-headers `((foo "bar\r\x01;qux"))))
;; Unfortunately, there are no or very few HTTP implementations
;; which understand that newlines can be escaped with a backslash
;; in a quoted string. That's why we don't allow it.
@@ -644,7 +644,7 @@
;; of header (URLencoding, removing the newlines from cookies, etc)
(test-error* "Embedded newlines throw an error"
(exn http unencoded-header)
- (test-unparse-headers `((foo "bar\n\x01qux"))))
+ (test-unparse-headers `((foo "bar\n\x01;qux"))))
(test "Alist"
"Foo: Bar=qux, Mooh=mumble\r\n"
(test-unparse-headers `((foo (bar . qux) (mooh . mumble)))))
@@ -668,7 +668,7 @@
(test-unparse-headers `((etag #("\"hi there" raw)))))
(test-error* "Embedded newlines in raw headers also throw an error"
(exn http unencoded-header)
- (test-unparse-headers `((foo #("bar\n\x01qux" raw))))))
+ (test-unparse-headers `((foo #("bar\n\x01;qux" raw))))))
(test-group "content-range unparser"
(test "Full content-range"
"Content-Range: bytes 500-999/1234\r\n"
@@ -763,7 +763,7 @@
(test "Old-style cookie expires value"
"Set-Cookie: foo=; Expires=Sunday, 20-Jul-08 15:23:42 GMT\r\n"
(test-unparse-headers `((set-cookie #(("foo" . "")
- ((expires . #(42 23 15 20 6 108 0 309 #f 0))))))))
+ ((expires . #(42 23 15 20 6 108 0 309 #f 0))))))))
(test "Secure (true)"
"Set-Cookie: foo=bar; Secure\r\n"
(test-unparse-headers `((set-cookie #(("foo" . "bar")
@@ -777,7 +777,7 @@
"Set-Cookie: foo=bar; Path=/blah\r\n"
(test-unparse-headers `((set-cookie #(("foo" . "bar")
((path . ,(uri-reference "/blah"))
- (secure . #f))))))))
+ (secure . #f))))))))
(test-group "authorization unparser"
(test "Basic auth"
"Authorization: Basic QWxpIEJhYmE6b3BlbiBzZXNhbWU=\r\n"
@@ -1180,7 +1180,7 @@
(update-response res status: 'unknown))
(test "any status can be used when code and reason are given directly"
"HTTP/1.1 999 No Way\r\n\r\ntest"
- (test-write-response
+ (test-write-response
(update-response res code: 999 reason: "No Way")
"test"))
(test "defaults can be parameterized"