[Guile-commits] 11/47: Add more R6RS port encoding tests

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 82357f7bd875afce351a2965a15baabf864338e3
Author: Mark H Weaver <address@hidden>
Date:   Sat Mar 28 16:01:23 2015 -0400

    Add more R6RS port encoding tests
    
    Originally applied to stable-2.0 as "Fix bytevector and custom binary
    ports to actually use ISO-8859-1 encoding.", commit
    d574d96f879c147c6c14df43f2e4ff9e8a6876b9.  Related to
    http://bugs.gnu.org/20200, which was introduced in in stable-2.0 but
    never existed on master.  Test modified by Andy Wingo to add a
    `force-output' where needed.
    
    * test-suite/tests/r6rs-ports.test: Add tests.
---
 test-suite/tests/r6rs-ports.test |   47 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 47 insertions(+)

diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index 1441daf..4941dd7 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -356,6 +356,11 @@
     (with-fluids ((%default-port-encoding "UTF-8"))
       (binary-port? (open-bytevector-input-port #vu8(1 2 3)))))
 
+  (pass-if-equal "bytevector-input-port uses ISO-8859-1 (Guile extension)"
+      "©©"
+    (with-fluids ((%default-port-encoding "UTF-8"))
+      (get-string-all (open-bytevector-input-port #vu8(194 169 194 169)))))
+
   (pass-if-exception "bytevector-input-port is read-only"
     exception:wrong-type-arg
 
@@ -416,6 +421,23 @@
            (input-port? port)
            (bytevector=? (get-bytevector-all port) source))))
 
+  (pass-if-equal "make-custom-binary-input-port uses ISO-8859-1 (Guile 
extension)"
+      "©©"
+    (with-fluids ((%default-port-encoding "UTF-8"))
+      (let* ((source #vu8(194 169 194 169))
+             (read! (let ((pos 0)
+                          (len (bytevector-length source)))
+                      (lambda (bv start count)
+                        (let ((amount (min count (- len pos))))
+                          (if (> amount 0)
+                              (bytevector-copy! source pos
+                                                bv start amount))
+                          (set! pos (+ pos amount))
+                          amount))))
+             (port (make-custom-binary-input-port "the port" read!
+                                                  #f #f #f)))
+        (get-string-all port))))
+
   (pass-if "custom binary input port does not support `port-position'"
     (let* ((str "Hello Port!")
            (source (open-bytevector-input-port
@@ -716,6 +738,14 @@ not `set-port-position!'"
   (pass-if "bytevector-output-port is binary"
     (binary-port? (open-bytevector-output-port)))
 
+  (pass-if-equal "bytevector-output-port uses ISO-8859-1 (Guile extension)"
+      #vu8(194 169 194 169)
+    (with-fluids ((%default-port-encoding "UTF-8"))
+      (let-values (((port get-content)
+                    (open-bytevector-output-port)))
+        (put-string port "©©")
+        (get-content))))
+
   (pass-if "open-bytevector-output-port [extract after close]"
     (let-values (((port get-content)
                   (open-bytevector-output-port)))
@@ -819,6 +849,23 @@ not `set-port-position!'"
            (not eof?)
            (bytevector=? sink source))))
 
+  (pass-if-equal "custom-binary-output-port uses ISO-8859-1 (Guile extension)"
+      '(194 169 194 169)
+    (with-fluids ((%default-port-encoding "UTF-8"))
+      (let* ((sink '())
+             (write! (lambda (bv start count)
+                       (if (= 0 count)  ; EOF
+                           0
+                           (let ((u8 (bytevector-u8-ref bv start)))
+                             ;; Get one byte at a time.
+                             (set! sink (cons u8 sink))
+                             1))))
+             (port (make-custom-binary-output-port "cbop" write!
+                                                   #f #f #f)))
+      (put-string port "©©")
+      (force-output port)
+      (reverse sink))))
+
   (pass-if "standard-output-port is binary"
     (with-fluids ((%default-port-encoding "UTF-8"))
       (binary-port? (standard-output-port))))