Add support for CHICKEN 66.4

This is backwards-compatible - there are only a handful of changes
needed, so we don't have to make a hard break here.

2 files changed, 18 insertions, 6 deletions

diff --git a/tests/run.scm b/tests/run.scm
index 722d6e3..d7e3d27 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -74,8 +74,8 @@
                absolute-uri: #f)
 (test-end "vhost support")
 
-(define chicken-logo.png (with-input-from-file "testweb/pics/chicken-logo.png" read-string))
-(define lambda-chicken.gif (with-input-from-file "testweb/pics/lambda-chicken.gif" read-string))
+(define chicken-logo.png (with-input-from-file "testweb/pics/chicken-logo.png" read-bytevector))
+(define lambda-chicken.gif (with-input-from-file "testweb/pics/lambda-chicken.gif" read-bytevector))
 (define index.html (with-input-from-file "testweb/index.html" read-string))
 (define index-subdir (with-input-from-file "testweb/subdir/index.html" read-string))
 (define index-subsubdir (with-input-from-file "testweb/subdir/subsubdir/index.html" read-string))
@@ -100,11 +100,11 @@
              "/hello.txt" "testhost")
 (test-header "image/gif mimetype" content-type (image/gif)
              "/pics/lambda-chicken.gif" "testhost")
-(test-response "image/gif contents" (200 lambda-chicken.gif)
+(test-binary-response "image/gif contents" (200 lambda-chicken.gif)
                "/pics/lambda-chicken.gif" "testhost")
 (test-header "image/png mimetype" content-type (image/png)
              "/pics/chicken-logo.png" "testhost")
-(test-response "image/png contents" (200 chicken-logo.png)
+(test-binary-response "image/png contents" (200 chicken-logo.png)
                "/pics/chicken-logo.png" "testhost")
 (test-header "unknown mimetype" content-type (application/unknown)
              "/data" "testhost")
diff --git a/tests/testlib.scm b/tests/testlib.scm
index f706753..d124554 100644
--- a/tests/testlib.scm
+++ b/tests/testlib.scm
@@ -3,6 +3,10 @@
         (chicken tcp) (chicken process) (chicken file posix)
         uri-common intarweb srfi-18)
 
+(cond-expand
+  (chicken-6)
+  (else (define read-bytevector read-string)))
+
 (server-port (string->number
                (or (get-environment-variable "SPIFFY_TEST_PORT") "8080")))
 
@@ -67,7 +71,7 @@
 
 ;;;; test tools
 
-(define (fetch-file file host #!key (send-headers `((host (,host . ,(server-port))))) (get-headers #f) (version '(1 0)) (method 'GET) (absolute-uri #t))
+(define (fetch-file file host #!key (send-headers `((host (,host . ,(server-port))))) (get-headers #f) (version '(1 0)) (method 'GET) (absolute-uri #t) (binary #f))
   (set! response-error? #f)
   (let ((uri (uri-reference (if absolute-uri
                                 (sprintf "http://~A:~A~A" host (server-port) file)
@@ -80,7 +84,8 @@
                                 headers: req-headers port: out)))
         (write-request req)
         (let* ((resp (read-response in))
-               (str (read-string (header-value 'content-length (response-headers resp)) in)))
+               (str ((if binary read-bytevector read-string)
+                     (header-value 'content-length (response-headers resp)) in)))
           (close-output-port out)
           (close-input-port in)
           (if get-headers
@@ -94,6 +99,13 @@
    ((_ ?text ?code-expected ?args ...)
     (test ?text ?code-expected (car (fetch-file ?args ...))))))
 
+(define-syntax test-binary-response
+  (syntax-rules ()
+   ((_ ?text (?code-expected ?contents-expected) ?args ...)
+    (test ?text (list ?code-expected ?contents-expected) (fetch-file ?args ... binary: #t)))
+   ((_ ?text ?code-expected ?args ...)
+    (test ?text ?code-expected (car (fetch-file ?args ... binary: #t))))))
+
 (define-syntax test-header
   (syntax-rules ()
     ((_ ?text ?header-name (?header-values ...) ?args ...)