diff options
author | Ludovic Courtès <ludo@gnu.org> | 2011-02-02 16:19:48 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2011-02-02 18:06:28 +0100 |
commit | b1e76e8f2c8997f011ca3a68ddfa2e448867108c (patch) | |
tree | 6f3eae2376f43c00521147b95ec37ff3814723f1 /module/rnrs | |
parent | b8fff11ed9bfdfe96dc86d1db97ab58286b5f8b5 (diff) | |
download | guile-b1e76e8f2c8997f011ca3a68ddfa2e448867108c.tar.gz |
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?'.
Diffstat (limited to 'module/rnrs')
-rw-r--r-- | module/rnrs/io/ports.scm | 39 |
1 files changed, 32 insertions, 7 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)) |