Automate the mime codec tests. Still need work.

diff --git a/tests/check.scm b/tests/check.scm
index 105d934a8edd8f529cad8b649d46b55a450fbaaf..bf1c7a116a41bbf4d0aef30d61188c1eefb1804f 100644 (file)
--- a/tests/check.scm
+++ b/tests/check.scm
@@ -50,6 +50,7 @@ USA.
     "runtime/test-floenv"
     "runtime/test-hash-table"
     "runtime/test-integer-bits"
+    "runtime/test-mime-codec"
     "runtime/test-thread-queue"
     "runtime/test-process"
     "runtime/test-readwrite"

diff --git a/tests/runtime/test-mime-codec.scm b/tests/runtime/test-mime-codec.scm
index df3f8eaed8be45ad69aa524fc859812318d6464b..21f0fa9dfd6fd07d27a9831c74027d3e1d8c41b2 100644 (file)
--- a/tests/runtime/test-mime-codec.scm
+++ b/tests/runtime/test-mime-codec.scm
@@ -37,16 +37,16 @@ USA.
        (do ((i 0 (+ i 1)))
            ((= i n-packets))
          (let ((packet-length (random packet-length)))
-           (write i)
-           (write-char #\space)
-           (write packet-length)
-           (write-char #\space)
-           (let ((packet 
+           (write i port)
+           (write-char #\space port)
+           (write packet-length port)
+           (write-char #\space port)
+           (let ((packet
                   (if text?
                       (random-text-string packet-length)
                       (random-byte-vector packet-length))))
-             (write packet)
-             (newline)
+             (write packet port)
+             (newline port)
              (update context packet 0 packet-length))))
        (finalize context)))))
 
@@ -146,4 +146,69 @@ USA.
                        (error "Output file shorter.")
                        (if (char=? c1 c3)
                            (loop)
-                           (error "Files don't match."))))))))))))
\ No newline at end of file
+                           (error "Files don't match."))))))))))))
+\f
+(define (for-each-setting procedure)
+  (procedure 20 1024 #t)
+  (procedure 20 1024 #f))
+
+(define (define-mime-codec-tests name
+         encode:initialize encode:finalize encode:update
+         decode:initialize decode:finalize decode:update)
+  (for-each-setting
+   (lambda (n-packets packet-length text?)
+     (define-test (symbol 'ENCODE '- name
+                         '/ (if text? 'TEXT 'BINARY)
+                         '/ n-packets
+                         '/ packet-length)
+       (lambda ()
+        (call-with-temporary-file-pathname
+          (lambda (pathname)
+            (test-encoder
+             n-packets packet-length text? pathname
+             encode:initialize encode:finalize encode:update)))))
+     (define-test (symbol 'CODEC '- name
+                         '/ (if text? 'TEXT 'BINARY)
+                         '/ n-packets
+                         '/ packet-length)
+       (lambda ()
+        (call-with-temporary-file-pathname
+          (lambda (pathname)
+            (test-codec
+             n-packets packet-length text? pathname
+             encode:initialize encode:finalize encode:update
+             decode:initialize decode:finalize decode:update))))))))
+
+(define-mime-codec-tests 'BASE64
+  encode-base64:initialize
+  encode-base64:finalize
+  encode-base64:update
+  decode-base64:initialize
+  decode-base64:finalize
+  decode-base64:update)
+
+#;
+(define-mime-codec-tests 'BINHEX40
+  encode-binhex40:initialize
+  encode-binhex40:finalize
+  encode-binhex40:update
+  decode-binhex40:initialize
+  decode-binhex40:finalize
+  decode-binhex40:update)
+
+(define-mime-codec-tests 'QUOTED-PRINTABLE
+  encode-quoted-printable:initialize
+  encode-quoted-printable:finalize
+  encode-quoted-printable:update
+  decode-quoted-printable:initialize
+  decode-quoted-printable:finalize
+  decode-quoted-printable:update)
+
+#;
+(define-mime-codec-tests 'UUE
+  encode-uue:initialize
+  encode-uue:finalize
+  encode-uue:update
+  decode-uue:initialize
+  decode-uue:finalize
+  decode-uue:update)
\ No newline at end of file