summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/rnrs/io/ports.scm8
-rw-r--r--test-suite/tests/r6rs-ports.test36
2 files changed, 38 insertions, 6 deletions
diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm
index 73271add8..854ea0919 100644
--- a/module/rnrs/io/ports.scm
+++ b/module/rnrs/io/ports.scm
@@ -197,6 +197,14 @@
read from its underlying binary port @var{port}."
(let ((result (%make-transcoded-port port)))
(set-port-encoding! result (transcoder-codec transcoder))
+ (case (transcoder-error-handling-mode transcoder)
+ ((raise)
+ (set-port-conversion-strategy! result 'error))
+ ((replace)
+ (set-port-conversion-strategy! result 'substitute))
+ (else
+ (error "unsupported error handling mode"
+ (transcoder-error-handling-mode transcoder))))
result))
(define (port-position port)
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index 7d746cab9..8d93f629f 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -18,11 +18,11 @@
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-io-ports)
- :use-module (test-suite lib)
- :use-module (srfi srfi-1)
- :use-module (srfi srfi-11)
- :use-module (rnrs io ports)
- :use-module (rnrs bytevectors))
+ #:use-module (test-suite lib)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
+ #:use-module (rnrs io ports)
+ #:use-module (rnrs bytevectors))
;;; All these tests assume Guile 1.8's port system, where characters are
;;; treated as octets.
@@ -497,7 +497,9 @@
(not eof?)
(bytevector=? sink source)))))
+
(with-test-prefix "8.2.6 Input and output ports"
+
(pass-if "transcoded-port [output]"
(let ((s "Hello\nÄÖÜ"))
(bytevector=?
@@ -507,6 +509,7 @@
(call-with-port (transcoded-port bv-port (make-transcoder (utf-8-codec)))
(lambda (utf8-port)
(put-string utf8-port s))))))))
+
(pass-if "transcoded-port [input]"
(let ((s "Hello\nÄÖÜ"))
(string=?
@@ -514,11 +517,32 @@
(get-string-all
(transcoded-port (open-bytevector-input-port (string->utf8 s))
(make-transcoder (utf-8-codec)))))))
+
(pass-if "transcoded-port [input line]"
(string=? "ÄÖÜ"
(get-line (transcoded-port
(open-bytevector-input-port (string->utf8 "ÄÖÜ\nFooBar"))
- (make-transcoder (utf-8-codec)))))))
+ (make-transcoder (utf-8-codec))))))
+
+ (pass-if "transcoded-port [error handling mode = raise]"
+ (let* ((t (make-transcoder (utf-8-codec) (native-eol-style)
+ (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 'encoding-error
+ (lambda ()
+ (get-line tp)
+ #f)
+ (lambda _
+ #t))))
+
+ (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)))))
;;; Local Variables:
;;; mode: scheme