summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/ref/api-io.texi16
-rw-r--r--libguile/ports.c112
-rw-r--r--libguile/strings.c25
-rw-r--r--libguile/strings.h2
-rw-r--r--test-suite/tests/ports.test81
-rw-r--r--test-suite/tests/r6rs-ports.test10
-rw-r--r--test-suite/tests/rdelim.test25
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: