Fix fencepost error in bip_seek

[bpt/guile.git] / test-suite / tests / r6rs-ports.test

diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index df056a4..01d8235 100644 (file)
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -320,6 +320,15 @@
                          (u8-list->bytevector
                           (map char->integer (string->list "Port!")))))))
 
+  (pass-if "bytevector input port can seek to very end"
+    (let ((empty (open-bytevector-input-port '#vu8()))
+          (not-empty (open-bytevector-input-port '#vu8(1 2 3))))
+      (and (begin (set-port-position! empty (port-position empty))
+                  (= 0 (port-position empty)))
+           (begin (get-bytevector-n not-empty 3)
+                  (set-port-position! not-empty (port-position not-empty))
+                  (= 3 (port-position not-empty))))))
+
   (pass-if-exception "make-custom-binary-input-port [wrong-num-args]"
     exception:wrong-num-args
 
@@ -397,7 +406,11 @@
 
       (close-port port)
       (gc) ; Test for marking a closed port.
-      closed?)))
+      closed?))
+
+  (pass-if "standard-input-port is binary"
+    (with-fluids ((%default-port-encoding "UTF-8"))
+      (binary-port? (standard-input-port)))))
 
 \f
 (with-test-prefix "8.2.10 Output ports"
@@ -509,7 +522,15 @@
       (put-bytevector port source)
       (and (= sink-pos (bytevector-length source))
            (not eof?)
-           (bytevector=? sink source)))))
+           (bytevector=? sink source))))
+
+  (pass-if "standard-output-port is binary"
+    (with-fluids ((%default-port-encoding "UTF-8"))
+      (binary-port? (standard-output-port))))
+
+  (pass-if "standard-error-port is binary"
+    (with-fluids ((%default-port-encoding "UTF-8"))
+      (binary-port? (standard-error-port)))))
 
 \f
 (with-test-prefix "8.2.6  Input and output ports"
@@ -565,7 +586,39 @@
                         (char=? (i/o-encoding-error-char c) #\λ)
                         (bytevector=? (get) (string->utf8 "The letter ")))))
           (put-string tp "The letter λ cannot be represented in Latin-1.")
-          #f)))))
+          #f))))
+
+  (pass-if "port-transcoder [binary port]"
+    (not (port-transcoder (open-bytevector-input-port #vu8()))))
+
+  (pass-if "port-transcoder [transcoded port]"
+    (let* ((p (transcoded-port (open-bytevector-input-port (string->utf8 "foo"))
+                               (make-transcoder (utf-8-codec))))
+           (t (port-transcoder p)))
+      (and t
+           (transcoder-codec t)
+           (eq? (native-eol-style)
+                (transcoder-eol-style t))
+           (eq? (error-handling-mode replace)
+                (transcoder-error-handling-mode t))))))
+
+(with-test-prefix "8.2.9  Textual input"
+  
+  (pass-if "get-string-n [short]"
+    (let ((port (open-input-string "GNU Guile")))
+      (string=? "GNU " (get-string-n port 4))))
+  (pass-if "get-string-n [long]"
+    (let ((port (open-input-string "GNU Guile")))
+      (string=? "GNU Guile" (get-string-n port 256))))
+  (pass-if "get-string-n [eof]"
+    (let ((port (open-input-string "")))
+      (eof-object? (get-string-n port 4))))
+
+  (pass-if "get-string-n! [short]"
+    (let ((port (open-input-string "GNU Guile"))
+          (s (string-copy "Isn't XXX great?")))
+      (and (= 3 (get-string-n! port s 6 3))
+           (string=? s "Isn't GNU great?")))))
 
 ;;; Local Variables:
 ;;; mode: scheme