R6RS: Have `get-char', `get-line', etc. raise an `&i/o-decoding-error'.

* module/rnrs/io/ports.scm (&i/o-decoding): New error condition type.
  (with-i/o-decoding-error): New macro.
  (get-char, get-datum, get-line, get-string-all, lookahead-char): Use
  it.

* test-suite/tests/r6rs-ports.test ("8.2.6  Input and output
  ports")["transcoded-port [error handling mode = raise]"]: Use `guard'
  and `i/o-decoding-error?'.

diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm
index 15d62bd..0eac165 100644 (file)
--- 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))))
 
+\f
+;;;
+;;; 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)))
 
 \f
+;;;
+;;; 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 4918fb0..5430f75 100644 (file)
--- 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: