diff options
-rw-r--r-- | module/rnrs/io/ports.scm | 8 | ||||
-rw-r--r-- | test-suite/tests/r6rs-ports.test | 36 |
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 |