#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (rnrs io ports)
+ #:use-module (rnrs exceptions)
#:use-module (rnrs bytevectors))
;;; All these tests assume Guile 1.8's port system, where characters are
(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
(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"
(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"
(error-handling-mode raise)))
(b (open-bytevector-input-port #vu8(255 2 1)))
(tp (transcoded-port b t)))
- ;; FIXME: Should be (guard (c ((i/o-decoding-error? c) #t)) ...).
- (catch 'decoding-error
- (lambda ()
- (get-line tp)
- #f)
- (lambda _
- #t))))
+ (guard (c ((i/o-decoding-error? c)
+ (eq? (i/o-error-port c) tp)))
+ (get-line tp))))
(pass-if "transcoded-port [error handling mode = replace]"
(let* ((t (make-transcoder (utf-8-codec) (native-eol-style)
(error-handling-mode replace)))
(b (open-bytevector-input-port #vu8(255 1 2 3 103 110 117)))
(tp (transcoded-port b t)))
- (string-suffix? "gnu" (get-line tp)))))
+ (string-suffix? "gnu" (get-line tp))))
+
+ (pass-if "transcoded-port, output [error handling mode = raise]"
+ (let-values (((p get)
+ (open-bytevector-output-port)))
+ (let* ((t (make-transcoder (latin-1-codec) (native-eol-style)
+ (error-handling-mode raise)))
+ (tp (transcoded-port p t)))
+ (guard (c ((i/o-encoding-error? c)
+ (and (eq? (i/o-error-port c) tp)
+ (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))))
+
+ (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
+;;; eval: (put 'guard 'scheme-indent-function 1)
;;; End: