1
Fork 0
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:
Andy Wingo 2016-05-10 11:34:17 +02:00
parent 83e5ccb02f
commit 1953d29038
3 changed files with 24 additions and 26 deletions

View file

@ -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;
}

View file

@ -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))

View file

@ -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)))))))