1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 20:30:28 +02:00

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?'.
This commit is contained in:
Ludovic Courtès 2011-02-02 16:19:48 +01:00
parent b8fff11ed9
commit b1e76e8f2c
2 changed files with 37 additions and 14 deletions

View file

@ -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))

View file

@ -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: