mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-28 16:00:22 +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;
|
||||
}
|
||||
|
||||
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. */
|
||||
scm_t_wchar
|
||||
scm_getc (SCM port)
|
||||
#define FUNC_NAME "scm_getc"
|
||||
{
|
||||
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))
|
||||
/* 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_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;
|
||||
}
|
||||
|
|
|
@ -822,21 +822,32 @@
|
|||
;; Mini DSL to test decoding error handling.
|
||||
(letrec-syntax ((decoding-error?
|
||||
(syntax-rules ()
|
||||
((_ port exp)
|
||||
((_ port proc)
|
||||
(catch 'decoding-error
|
||||
(lambda ()
|
||||
(pk 'exp exp)
|
||||
(pk 'proc (proc port))
|
||||
#f)
|
||||
(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)
|
||||
(not (= 0 errno))))))))
|
||||
(not (= 0 errno))
|
||||
(skip-over-error)))))))
|
||||
(make-check
|
||||
(syntax-rules (-> error eof)
|
||||
((_ port (proc -> error))
|
||||
(if (eq? 'substitute
|
||||
(port-conversion-strategy port))
|
||||
(eqv? (proc port) #\?)
|
||||
(decoding-error? port (proc port))))
|
||||
(decoding-error? port proc)))
|
||||
((_ port (proc -> eof))
|
||||
(eof-object? (proc port)))
|
||||
((_ port (proc -> char))
|
||||
|
|
|
@ -19,7 +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 ((rnrs io ports) #:select (open-bytevector-input-port get-u8))
|
||||
#:use-module (test-suite lib))
|
||||
|
||||
(with-test-prefix "read-line"
|
||||
|
@ -79,8 +79,7 @@
|
|||
#f)
|
||||
(lambda (key subr message err port)
|
||||
(and (eq? port p)
|
||||
|
||||
;; PORT should now point past the error.
|
||||
(eqv? (get-u8 p) 255)
|
||||
(string=? (read-line p) "BCD")
|
||||
(eof-object? (read-line p)))))))
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue