1 files changed, 71 insertions, 67 deletions
diff --git a/tests/run.scm b/tests/run.scm
index 9ad7fd8..0308bcc 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -303,38 +303,40 @@
             expected-data (log-body log))))
 
   (test-group "alist form data body with custom port"
-    (let* ((string-port (open-input-string "the file's contents"))
-           (custom-port (make-input-port (lambda () (read-char string-port))
-                                         (constantly #t)
-                                         (lambda () (close-input-port string-port))
-                                         read-bytevector: (lambda (p bytes buf off) (read-bytevector! buf string-port off bytes))))
-           (log (with-server-response
-                 (lambda ()
-                   (with-input-from-request
-                    "http://example.com"
-                    `((lala . "testing")
-                      (the-file file: ,custom-port
-                                filename: "str")
-                      ("more" . stuff))
-                    read-string))
-                 "HTTP/1.0 200 OK\r\n\r\n"))
-           (req (log-request log))
-           (h (request-headers req))
-           (boundary (header-param 'boundary 'content-type h))
-           (expected-data
-            (conc
-             "--" boundary "\r\n"
-             "Content-Disposition: form-data; name=\"lala\"\r\n\r\n"
-             "testing\r\n"
-             "--" boundary "\r\n"
-             "Content-Disposition: form-data; name=\"the-file\"; "
-             "filename=\"str\"\r\n"
-             "Content-Type: application/octet-stream\r\n\r\n"
-             "the file's contents\r\n"
-             "--" boundary "\r\n"
-             "Content-Disposition: form-data; name=\"more\"\r\n\r\n"
-             "stuff\r\n"
-             "--" boundary "--\r\n")))
+    (letrec* ((string-port (open-input-string "the file's contents"))
+              (read-bv-from-sp (case-lambda ((p bytes buf off) (read-bv-from-sp buf off (+ bytes off)))
+                                            ((buf start end) (read-bytevector! buf string-port start end))))
+              (custom-port (make-input-port (lambda () (read-char string-port))
+                                            (constantly #t)
+                                            (lambda () (close-input-port string-port))
+                                            read-bytevector: read-bv-from-sp))
+              (log (with-server-response
+                    (lambda ()
+                      (with-input-from-request
+                       "http://example.com"
+                       `((lala . "testing")
+                         (the-file file: ,custom-port
+                                   filename: "str")
+                         ("more" . stuff))
+                       read-string))
+                    "HTTP/1.0 200 OK\r\n\r\n"))
+              (req (log-request log))
+              (h (request-headers req))
+              (boundary (header-param 'boundary 'content-type h))
+              (expected-data
+               (conc
+                "--" boundary "\r\n"
+                "Content-Disposition: form-data; name=\"lala\"\r\n\r\n"
+                "testing\r\n"
+                "--" boundary "\r\n"
+                "Content-Disposition: form-data; name=\"the-file\"; "
+                "filename=\"str\"\r\n"
+                "Content-Type: application/octet-stream\r\n\r\n"
+                "the file's contents\r\n"
+                "--" boundary "\r\n"
+                "Content-Disposition: form-data; name=\"more\"\r\n\r\n"
+                "stuff\r\n"
+                "--" boundary "--\r\n")))
 
       (test "Request method" 'POST (request-method req))
       (test "Content type is multipart"
@@ -352,41 +354,43 @@
             expected-data (log-body log))))
 
   (test-group "alist form data body with custom port using HTTP/1.0"
-    (let* ((string-port (open-input-string "the file's contents"))
-           (custom-port (make-input-port (lambda () (read-char string-port))
-                                         (constantly #t)
-                                         (lambda () (close-input-port string-port))
-                                         read-bytevector: (lambda (p bytes buf off) (read-bytevector! buf string-port off bytes))))
-           (uri (uri-reference "http://example.com"))
-           (req (make-request uri: uri method: 'POST
-                              major: 1 minor: 0))
-           (log (with-server-response
-                 (lambda ()
-                   (with-input-from-request
-                    req
-                    `((lala . "testing")
-                      (the-file file: ,custom-port
-                                filename: "str")
-                      ("more" . stuff))
-                    read-string))
-                 "HTTP/1.0 200 OK\r\n\r\n"))
-           (req (log-request log))
-           (h (request-headers req))
-           (boundary (header-param 'boundary 'content-type h))
-           (expected-data
-            (conc
-             "--" boundary "\r\n"
-             "Content-Disposition: form-data; name=\"lala\"\r\n\r\n"
-             "testing\r\n"
-             "--" boundary "\r\n"
-             "Content-Disposition: form-data; name=\"the-file\"; "
-             "filename=\"str\"\r\n"
-             "Content-Type: application/octet-stream\r\n\r\n"
-             "the file's contents\r\n"
-             "--" boundary "\r\n"
-             "Content-Disposition: form-data; name=\"more\"\r\n\r\n"
-             "stuff\r\n"
-             "--" boundary "--\r\n")))
+    (letrec* ((string-port (open-input-string "the file's contents"))
+              (read-bv-from-sp (case-lambda ((p bytes buf off) (read-bv-from-sp buf off (+ bytes off)))
+                                            ((buf start end) (read-bytevector! buf string-port start end))))
+              (custom-port (make-input-port (lambda () (read-char string-port))
+                                            (constantly #t)
+                                            (lambda () (close-input-port string-port))
+                                            read-bytevector: read-bv-from-sp))
+              (uri (uri-reference "http://example.com"))
+              (req (make-request uri: uri method: 'POST
+                                 major: 1 minor: 0))
+              (log (with-server-response
+                    (lambda ()
+                      (with-input-from-request
+                       req
+                       `((lala . "testing")
+                         (the-file file: ,custom-port
+                                   filename: "str")
+                         ("more" . stuff))
+                       read-string))
+                    "HTTP/1.0 200 OK\r\n\r\n"))
+              (req (log-request log))
+              (h (request-headers req))
+              (boundary (header-param 'boundary 'content-type h))
+              (expected-data
+               (conc
+                "--" boundary "\r\n"
+                "Content-Disposition: form-data; name=\"lala\"\r\n\r\n"
+                "testing\r\n"
+                "--" boundary "\r\n"
+                "Content-Disposition: form-data; name=\"the-file\"; "
+                "filename=\"str\"\r\n"
+                "Content-Type: application/octet-stream\r\n\r\n"
+                "the file's contents\r\n"
+                "--" boundary "\r\n"
+                "Content-Disposition: form-data; name=\"more\"\r\n\r\n"
+                "stuff\r\n"
+                "--" boundary "--\r\n")))
 
       (test "Request method" 'POST (request-method req))
       (test "Content type is multipart"