Fix read-bytevector argument count in make-delimited-input-port2.0.1

Similar to the 7c9edbf change in intarweb 3.0.1:

In CHICKEN 6.0.0, the signature was documented to be different, but
we were using the actual signature.  For later CHICKEN versions, the
signature was updated to match the documentation so now we're kind of
stuck having to support both signatures.

Since we cannot cond-expand our way out of this because there are no
features that differ between 6.0.0 and 6.0.1, we'll have to use
case-lambda and convert the old signature to the new one.  Oh well...

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"