diff options
-rw-r--r-- | doc/ref/api-io.texi | 16 | ||||
-rw-r--r-- | libguile/ports.c | 112 | ||||
-rw-r--r-- | libguile/strings.c | 25 | ||||
-rw-r--r-- | libguile/strings.h | 2 | ||||
-rw-r--r-- | test-suite/tests/ports.test | 81 | ||||
-rw-r--r-- | test-suite/tests/r6rs-ports.test | 10 | ||||
-rw-r--r-- | test-suite/tests/rdelim.test | 25 |
7 files changed, 195 insertions, 76 deletions
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi index 47dc8fc3d..e02daeb93 100644 --- a/doc/ref/api-io.texi +++ b/doc/ref/api-io.texi @@ -1,7 +1,7 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2009, 2010 -@c Free Software Foundation, Inc. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2009, +@c 2010, 2011 Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @node Input and Output @@ -210,6 +210,10 @@ interactive port that has no ready characters. Return the next character available from @var{port}, updating @var{port} to point to the following character. If no more characters are available, the end-of-file object is returned. + +When @var{port}'s data cannot be decoded according to its +character encoding, a @code{decoding-error} is raised and +@var{port} points past the erroneous byte sequence. @end deffn @deftypefn {C Function} size_t scm_c_read (SCM port, void *buffer, size_t size) @@ -238,6 +242,11 @@ return the value returned by the preceding call to @code{peek-char}. In particular, a call to @code{peek-char} on an interactive port will hang waiting for input whenever a call to @code{read-char} would have hung. + +As for @code{read-char}, a @code{decoding-error} may be raised +if such a situation occurs. However, unlike with @code{read-char}, +@var{port} still points at the beginning of the erroneous byte +sequence when the error is raised. @end deffn @deffn {Scheme Procedure} unread-char cobj [port] @@ -513,6 +522,9 @@ Push the terminating delimiter (if any) back on to the port. Return a pair containing the string read from the port and the terminating delimiter or end-of-file object. @end table + +Like @code{read-char}, this procedure can throw to @code{decoding-error} +(@pxref{Reading, @code{read-char}}). @end deffn @c begin (scm-doc-string "rdelim.scm" "read-line!") diff --git a/libguile/ports.c b/libguile/ports.c index 1cfcba021..46404bec1 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -1029,7 +1029,11 @@ SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0, (SCM port), "Return the next character available from @var{port}, updating\n" "@var{port} to point to the following character. If no more\n" - "characters are available, the end-of-file object is returned.") + "characters are available, the end-of-file object is returned.\n" + "\n" + "When @var{port}'s data cannot be decoded according to its\n" + "character encoding, a @code{decoding-error} is raised and\n" + "@var{port} points past the erroneous byte sequence.\n") #define FUNC_NAME s_scm_read_char { scm_t_wchar c; @@ -1108,17 +1112,16 @@ utf8_to_codepoint (const scm_t_uint8 *utf8_buf, size_t size) return codepoint; } -/* Read a codepoint from PORT and return it. Fill BUF with the byte - representation of the codepoint in PORT's encoding, and set *LEN to - the length in bytes of that representation. Raise an error on - failure. */ -static scm_t_wchar -get_codepoint (SCM port, char buf[SCM_MBCHAR_BUF_SIZE], size_t *len) -#define FUNC_NAME "scm_getc" +/* Read a codepoint from PORT and return it in *CODEPOINT. Fill BUF + with the byte representation of the codepoint in PORT's encoding, and + set *LEN to the length in bytes of that representation. Return 0 on + success and an errno value on error. */ +static int +get_codepoint (SCM port, scm_t_wchar *codepoint, + char buf[SCM_MBCHAR_BUF_SIZE], size_t *len) { int err, byte_read; size_t bytes_consumed, output_size; - scm_t_wchar codepoint; char *output; scm_t_uint8 utf8_buf[SCM_MBCHAR_BUF_SIZE]; scm_t_port *pt = SCM_PTAB_ENTRY (port); @@ -1140,7 +1143,11 @@ get_codepoint (SCM port, char buf[SCM_MBCHAR_BUF_SIZE], size_t *len) if (byte_read == EOF) { if (bytes_consumed == 0) - return (scm_t_wchar) EOF; + { + *codepoint = (scm_t_wchar) EOF; + *len = 0; + return 0; + } else continue; } @@ -1164,53 +1171,52 @@ get_codepoint (SCM port, char buf[SCM_MBCHAR_BUF_SIZE], size_t *len) output_size = sizeof (utf8_buf) - output_left; } - if (err != 0) + if (SCM_UNLIKELY (err != 0)) { /* Reset the `iconv' state. */ iconv (pt->input_cd, NULL, NULL, NULL, NULL); if (pt->ilseq_handler == SCM_ICONVEH_QUESTION_MARK) - codepoint = '?'; - else - /* Fail when the strategy is SCM_ICONVEH_ERROR or - SCM_ICONVEH_ESCAPE_SEQUENCE (the latter doesn't make sense - for input encoding errors.) */ - goto failure; + { + *codepoint = '?'; + err = 0; + } + + /* Fail when the strategy is SCM_ICONVEH_ERROR or + SCM_ICONVEH_ESCAPE_SEQUENCE (the latter doesn't make sense for + input encoding errors.) */ } else /* Convert the UTF8_BUF sequence to a Unicode code point. */ - codepoint = utf8_to_codepoint (utf8_buf, output_size); + *codepoint = utf8_to_codepoint (utf8_buf, output_size); - update_port_lf (codepoint, port); + if (SCM_LIKELY (err == 0)) + update_port_lf (*codepoint, port); *len = bytes_consumed; - return codepoint; - - failure: - { - SCM bv; - - bv = scm_c_make_bytevector (bytes_consumed); - memcpy (SCM_BYTEVECTOR_CONTENTS (bv), buf, bytes_consumed); - scm_encoding_error (FUNC_NAME, err, "input decoding error", - pt->encoding, "UTF-8", bv); - } - - /* Never gets here. */ - return 0; + return err; } -#undef FUNC_NAME /* Read a codepoint from PORT and return it. */ scm_t_wchar scm_getc (SCM port) +#define FUNC_NAME "scm_getc" { + int err; size_t len; + scm_t_wchar codepoint; char buf[SCM_MBCHAR_BUF_SIZE]; - return get_codepoint (port, buf, &len); + err = get_codepoint (port, &codepoint, buf, &len); + if (SCM_UNLIKELY (err != 0)) + /* At this point PORT should point past the invalid encoding, as per + R6RS-lib Section 8.2.4. */ + scm_decoding_error (FUNC_NAME, err, "input decoding error", port); + + return codepoint; } +#undef FUNC_NAME /* this should only be called when the read buffer is empty. it tries to refill the read buffer. it returns the first char from @@ -1623,13 +1629,19 @@ SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0, "return the value returned by the preceding call to\n" "@code{peek-char}. In particular, a call to @code{peek-char} on\n" "an interactive port will hang waiting for input whenever a call\n" - "to @code{read-char} would have hung.") + "to @code{read-char} would have hung.\n" + "\n" + "As for @code{read-char}, a @code{decoding-error} may be raised\n" + "if such a situation occurs. However, unlike with @code{read-char},\n" + "@var{port} still points at the beginning of the erroneous byte\n" + "sequence when the error is raised.\n") #define FUNC_NAME s_scm_peek_char { + int err; SCM result; scm_t_wchar c; char bytes[SCM_MBCHAR_BUF_SIZE]; - long column, line; + long column, line, i; size_t len; if (SCM_UNBNDP (port)) @@ -1639,21 +1651,25 @@ SCM_DEFINE (scm_peek_char, "peek-char", 0, 1, 0, column = SCM_COL (port); line = SCM_LINUM (port); - c = get_codepoint (port, bytes, &len); - if (c == EOF) - result = SCM_EOF_VAL; - else - { - long i; + err = get_codepoint (port, &c, bytes, &len); + + for (i = len - 1; i >= 0; i--) + scm_unget_byte (bytes[i], port); - result = SCM_MAKE_CHAR (c); + SCM_COL (port) = column; + SCM_LINUM (port) = line; - for (i = len - 1; i >= 0; i--) - scm_unget_byte (bytes[i], port); + if (SCM_UNLIKELY (err != 0)) + { + scm_decoding_error (FUNC_NAME, err, "input decoding error", port); - SCM_COL (port) = column; - SCM_LINUM (port) = line; + /* Shouldn't happen since `catch' always aborts to prompt. */ + result = SCM_BOOL_F; } + else if (c == EOF) + result = SCM_EOF_VAL; + else + result = SCM_MAKE_CHAR (c); return result; } diff --git a/libguile/strings.c b/libguile/strings.c index 41998a92b..7a580609e 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -1407,9 +1407,11 @@ SCM_DEFINE (scm_string_append, "string-append", 0, 0, 1, -/* Conversion to/from other encodings. */ +/* Charset conversion error handling. */ SCM_SYMBOL (scm_encoding_error_key, "encoding-error"); +SCM_SYMBOL (scm_decoding_error_key, "decoding-error"); + void scm_encoding_error (const char *subr, int err, const char *message, const char *from, const char *to, SCM string_or_bv) @@ -1428,6 +1430,22 @@ scm_encoding_error (const char *subr, int err, const char *message, SCM_UNDEFINED)); } +/* Raise an exception informing of an encoding error on PORT. This + means that a character could not be written in PORT's encoding. */ +void +scm_decoding_error (const char *subr, int err, const char *message, SCM port) +{ + scm_throw (scm_decoding_error_key, + scm_list_n (scm_from_locale_string (subr), + scm_from_locale_string (message), + scm_from_int (err), + port, + SCM_UNDEFINED)); +} + + +/* String conversion to/from C. */ + SCM scm_from_stringn (const char *str, size_t len, const char *encoding, scm_t_string_failed_conversion_handler handler) @@ -1473,9 +1491,8 @@ scm_from_stringn (const char *str, size_t len, const char *encoding, memcpy (buf, str, len); bv = scm_c_take_bytevector (buf, len); - scm_encoding_error (__func__, errno, - "input locale conversion error", - encoding, "UTF-32", bv); + scm_decoding_error (__func__, errno, + "input locale conversion error", bv); } i = 0; diff --git a/libguile/strings.h b/libguile/strings.h index b9e901b6c..329e6c185 100644 --- a/libguile/strings.h +++ b/libguile/strings.h @@ -214,6 +214,8 @@ SCM_INTERNAL void scm_encoding_error (const char *subr, int err, const char *message, const char *from, const char *to, SCM string_or_bv); +SCM_INTERNAL void scm_decoding_error (const char *subr, int err, + const char *message, SCM port); /* internal utility functions. */ diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test index 8d3f6727c..a794b94d5 100644 --- a/test-suite/tests/ports.test +++ b/test-suite/tests/ports.test @@ -464,29 +464,80 @@ (= (port-line p) 0) (= (port-column p) 0)))) - (pass-if-exception "read-char, wrong encoding, error" - exception:encoding-error + (pass-if "read-char, wrong encoding, error" (let ((p (with-fluids ((%default-port-encoding "UTF-8")) - (open-bytevector-input-port #vu8(255 1 2 3))))) - (set-port-conversion-strategy! p 'error) - (read-char p) - #t)) - - (pass-if-exception "read-char, wrong encoding, escape" - exception:encoding-error - ;; `escape' should behave like `error'. + (open-bytevector-input-port #vu8(255 65 66 67))))) + (catch 'decoding-error + (lambda () + (set-port-conversion-strategy! p 'error) + (read-char p) + #f) + (lambda (key subr message err port) + (and (eq? port p) + + ;; PORT should point past the error. + (equal? '(#\A #\B #\C) + (list (read-char port) + (read-char port) + (read-char port))) + + (eof-object? (read-char port))))))) + + (pass-if "read-char, wrong encoding, escape" + ;; `escape' should behave exactly like `error'. (let ((p (with-fluids ((%default-port-encoding "UTF-8")) - (open-bytevector-input-port #vu8(255 1 2 3))))) - (set-port-conversion-strategy! p 'escape) - (read-char p) - #t)) + (open-bytevector-input-port #vu8(255 65 66 67))))) + (catch 'decoding-error + (lambda () + (set-port-conversion-strategy! p 'escape) + (read-char p) + #f) + (lambda (key subr message err port) + (and (eq? port p) + + ;; PORT should point past the error. + (equal? '(#\A #\B #\C) + (list (read-char port) + (read-char port) + (read-char port))) + + (eof-object? (read-char port))))))) (pass-if "read-char, wrong encoding, substitute" (let ((p (with-fluids ((%default-port-encoding "UTF-8")) (open-bytevector-input-port #vu8(255 206 187 206 188))))) (set-port-conversion-strategy! p 'substitute) (equal? (list (read-char p) (read-char p) (read-char p)) - '(#\? #\λ #\μ))))) + '(#\? #\λ #\μ)))) + + (pass-if "peek-char, wrong encoding, error" + (let-syntax ((decoding-error? + (syntax-rules () + ((_ port exp) + (catch 'decoding-error + (lambda () + (pk 'exp exp) + #f) + (lambda (key subr message errno p) + (eq? p port))))))) + (let ((p (with-fluids ((%default-port-encoding "UTF-8")) + (open-bytevector-input-port #vu8(255 65 66 67))))) + (set-port-conversion-strategy! p 'error) + + ;; `peek-char' should repeatedly raise an error. + (and (decoding-error? p (peek-char p)) + (decoding-error? p (peek-char p)) + (decoding-error? p (peek-char p)) + + ;; Move past the error. + (decoding-error? p (read-char p)) + + ;; Finish happily. + (equal? '(#\A #\B #\C) + (list (read-char p) + (read-char p) + (read-char p))) + (eof-object? (read-char p))))))) (with-test-prefix "call-with-output-string" diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test index 410e9d12e..4918fb01e 100644 --- a/test-suite/tests/r6rs-ports.test +++ b/test-suite/tests/r6rs-ports.test @@ -262,16 +262,14 @@ (pass-if "put-bytevector with wrong-encoding string port" (let* ((str "hello, world") (bv (string->utf16 str))) - (catch 'encoding-error + (catch 'decoding-error (lambda () (with-fluids ((%default-port-encoding "UTF-32")) (call-with-output-string (lambda (port) (put-bytevector port bv))))) - (lambda (key subr message errno from to faulty-bv) - (and (bytevector=? faulty-bv bv) - (string=? to "UTF-32") - (string? (strerror errno)))))))) + (lambda (key subr message errno port) + (string? (strerror errno))))))) (with-test-prefix "7.2.7 Input Ports" @@ -545,7 +543,7 @@ (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 + (catch 'decoding-error (lambda () (get-line tp) #f) diff --git a/test-suite/tests/rdelim.test b/test-suite/tests/rdelim.test index ec7e5b4ee..dd81dc903 100644 --- a/test-suite/tests/rdelim.test +++ b/test-suite/tests/rdelim.test @@ -19,6 +19,7 @@ (define-module (test-suite test-rdelim) #:use-module (ice-9 rdelim) + #:use-module ((rnrs io ports) #:select (open-bytevector-input-port)) #:use-module (test-suite lib)) (with-fluids ((%default-port-encoding "UTF-8")) @@ -63,11 +64,33 @@ (read-line p 'split))) (eof-object? (read-line p))))) - (pass-if "two Greek lines, trim" + (pass-if "two Greek lines, trim" (let* ((s "λαμβδα\nμυ\n") (p (open-input-string s))) (and (equal? (string-tokenize s) (list (read-line p) (read-line p))) + (eof-object? (read-line p))))) + + (pass-if "decoding error" + (let ((p (with-fluids ((%default-port-encoding "UTF-8")) + (open-bytevector-input-port #vu8(65 255 66 67 68))))) + (set-port-conversion-strategy! p 'error) + (catch 'decoding-error + (lambda () + (read-line p) + #f) + (lambda (key subr message err port) + (and (eq? port p) + + ;; PORT should now point past the error. + (string=? (read-line p) "BCD") + (eof-object? (read-line p))))))) + + (pass-if "decoding error, substitute" + (let ((p (with-fluids ((%default-port-encoding "UTF-8")) + (open-bytevector-input-port #vu8(65 255 66 67 68))))) + (set-port-conversion-strategy! p 'substitute) + (and (string=? (read-line p) "A?BCD") (eof-object? (read-line p))))))) ;;; Local Variables: |