mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-30 00:40:20 +02:00
Decoding errors do not advance read pointer
* libguile/ports.c (scm_getc): If the port conversion strategy is 'error, signal an error before advancing the read pointer. This is a change from previous behavior; before, we advanced the read pointer under an understanding that that was what R6RS required. But, that seems to be not the case. * test-suite/tests/ports.test ("string ports"): Update decoding-error tests to assume that read-char with an error doesn't advance the read pointer. * test-suite/tests/rdelim.test ("read-line"): Likewise.
This commit is contained in:
parent
83e5ccb02f
commit
1953d29038
3 changed files with 24 additions and 26 deletions
|
@ -1811,34 +1811,22 @@ peek_codepoint (SCM port, scm_t_wchar *codepoint, size_t *len)
|
||||||
return err;
|
return err;
|
||||||
}
|
}
|
||||||
|
|
||||||
static SCM_C_INLINE int
|
|
||||||
get_codepoint (SCM port, scm_t_wchar *codepoint)
|
|
||||||
{
|
|
||||||
int err;
|
|
||||||
size_t len = 0;
|
|
||||||
scm_t_port *pt = SCM_PTAB_ENTRY (port);
|
|
||||||
|
|
||||||
err = peek_codepoint (port, codepoint, &len);
|
|
||||||
scm_port_buffer_did_take (pt->read_buf, len);
|
|
||||||
if (*codepoint == EOF)
|
|
||||||
scm_i_clear_pending_eof (port);
|
|
||||||
update_port_lf (*codepoint, port);
|
|
||||||
return err;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Read a codepoint from PORT and return it. */
|
/* Read a codepoint from PORT and return it. */
|
||||||
scm_t_wchar
|
scm_t_wchar
|
||||||
scm_getc (SCM port)
|
scm_getc (SCM port)
|
||||||
#define FUNC_NAME "scm_getc"
|
#define FUNC_NAME "scm_getc"
|
||||||
{
|
{
|
||||||
int err;
|
int err;
|
||||||
scm_t_wchar codepoint;
|
size_t len = 0;
|
||||||
|
scm_t_wchar codepoint = EOF;
|
||||||
|
|
||||||
err = get_codepoint (port, &codepoint);
|
err = peek_codepoint (port, &codepoint, &len);
|
||||||
if (SCM_UNLIKELY (err != 0))
|
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);
|
scm_decoding_error (FUNC_NAME, err, "input decoding error", port);
|
||||||
|
scm_port_buffer_did_take (SCM_PTAB_ENTRY (port)->read_buf, len);
|
||||||
|
if (codepoint == EOF)
|
||||||
|
scm_i_clear_pending_eof (port);
|
||||||
|
update_port_lf (codepoint, port);
|
||||||
|
|
||||||
return codepoint;
|
return codepoint;
|
||||||
}
|
}
|
||||||
|
|
|
@ -822,21 +822,32 @@
|
||||||
;; Mini DSL to test decoding error handling.
|
;; Mini DSL to test decoding error handling.
|
||||||
(letrec-syntax ((decoding-error?
|
(letrec-syntax ((decoding-error?
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
((_ port exp)
|
((_ port proc)
|
||||||
(catch 'decoding-error
|
(catch 'decoding-error
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(pk 'exp exp)
|
(pk 'proc (proc port))
|
||||||
#f)
|
#f)
|
||||||
(lambda (key subr message errno p)
|
(lambda (key subr message errno p)
|
||||||
|
(define (skip-over-error)
|
||||||
|
(let ((strategy (port-conversion-strategy p)))
|
||||||
|
(set-port-conversion-strategy! p 'substitute)
|
||||||
|
;; If `proc' is `read-char', this will
|
||||||
|
;; skip over the bad bytes.
|
||||||
|
(let ((c (proc p)))
|
||||||
|
(unless (eqv? c #\?)
|
||||||
|
(error "unexpected char" c))
|
||||||
|
(set-port-conversion-strategy! p strategy)
|
||||||
|
#t)))
|
||||||
(and (eq? p port)
|
(and (eq? p port)
|
||||||
(not (= 0 errno))))))))
|
(not (= 0 errno))
|
||||||
|
(skip-over-error)))))))
|
||||||
(make-check
|
(make-check
|
||||||
(syntax-rules (-> error eof)
|
(syntax-rules (-> error eof)
|
||||||
((_ port (proc -> error))
|
((_ port (proc -> error))
|
||||||
(if (eq? 'substitute
|
(if (eq? 'substitute
|
||||||
(port-conversion-strategy port))
|
(port-conversion-strategy port))
|
||||||
(eqv? (proc port) #\?)
|
(eqv? (proc port) #\?)
|
||||||
(decoding-error? port (proc port))))
|
(decoding-error? port proc)))
|
||||||
((_ port (proc -> eof))
|
((_ port (proc -> eof))
|
||||||
(eof-object? (proc port)))
|
(eof-object? (proc port)))
|
||||||
((_ port (proc -> char))
|
((_ port (proc -> char))
|
||||||
|
|
|
@ -19,7 +19,7 @@
|
||||||
|
|
||||||
(define-module (test-suite test-rdelim)
|
(define-module (test-suite test-rdelim)
|
||||||
#:use-module (ice-9 rdelim)
|
#:use-module (ice-9 rdelim)
|
||||||
#:use-module ((rnrs io ports) #:select (open-bytevector-input-port))
|
#:use-module ((rnrs io ports) #:select (open-bytevector-input-port get-u8))
|
||||||
#:use-module (test-suite lib))
|
#:use-module (test-suite lib))
|
||||||
|
|
||||||
(with-test-prefix "read-line"
|
(with-test-prefix "read-line"
|
||||||
|
@ -79,8 +79,7 @@
|
||||||
#f)
|
#f)
|
||||||
(lambda (key subr message err port)
|
(lambda (key subr message err port)
|
||||||
(and (eq? port p)
|
(and (eq? port p)
|
||||||
|
(eqv? (get-u8 p) 255)
|
||||||
;; PORT should now point past the error.
|
|
||||||
(string=? (read-line p) "BCD")
|
(string=? (read-line p) "BCD")
|
||||||
(eof-object? (read-line p)))))))
|
(eof-object? (read-line p)))))))
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue