mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-19 18:20:22 +02:00
Code Activity

Decoding errors do not advance read pointer

Browse source 
* 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
Download patch file Download diff file Expand all files Collapse all files

19
test-suite/tests/ports.test
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))

5
test-suite/tests/rdelim.test
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)))))))