summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/rnrs/io/ports.scm39
-rw-r--r--test-suite/tests/r6rs-ports.test12
2 files changed, 37 insertions, 14 deletions
diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm
index 15d62bd3f..0eac165cf 100644
--- a/module/rnrs/io/ports.scm
+++ b/module/rnrs/io/ports.scm
@@ -93,7 +93,9 @@
&i/o-file-does-not-exist i/o-file-does-not-exist-error?
make-i/o-file-does-not-exist-error
&i/o-port i/o-port-error? make-i/o-port-error
- i/o-error-port)
+ i/o-error-port
+ &i/o-decoding-error i/o-decoding-error?
+ make-i/o-decoding-error)
(import (only (rnrs base) assertion-violation)
(rnrs enums)
(rnrs records syntactic)
@@ -330,23 +332,46 @@ return the characters accumulated in that port."
(else
(display s port))))
+
+;;;
+;;; Textual input.
+;;;
+
+(define-condition-type &i/o-decoding &i/o-port
+ make-i/o-decoding-error i/o-decoding-error?)
+
+(define-syntax with-i/o-decoding-error
+ (syntax-rules ()
+ "Convert Guile throws to `decoding-error' to `&i/o-decoding-error'."
+ ((_ body ...)
+ ;; XXX: This is heavyweight for small functions like `get-char' and
+ ;; `lookahead-char'.
+ (with-throw-handler 'decoding-error
+ (lambda ()
+ (begin body ...))
+ (lambda (key subr message errno port)
+ (raise (make-i/o-decoding-error port)))))))
+
(define (get-char port)
- (read-char port))
+ (with-i/o-decoding-error (read-char port)))
(define (get-datum port)
- (read port))
+ (with-i/o-decoding-error (read port)))
(define (get-line port)
- (read-line port 'trim))
+ (with-i/o-decoding-error (read-line port 'trim)))
(define (get-string-all port)
- (read-delimited "" port 'concat))
+ (with-i/o-decoding-error (read-delimited "" port 'concat)))
(define (lookahead-char port)
- (peek-char port))
-
+ (with-i/o-decoding-error (peek-char port)))
+;;;
+;;; Standard ports.
+;;;
+
(define (standard-input-port)
(dup->inport 0))
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index 4918fb01e..5430f75cb 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -22,6 +22,7 @@
#: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
@@ -542,13 +543,9 @@
(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)
@@ -559,4 +556,5 @@
;;; Local Variables:
;;; mode: scheme
+;;; eval: (put 'guard 'scheme-indent-function 1)
;;; End: