fix position counting with internal read shortcut

The primitive `read` uses a shortcut --- a private "ungetc"
implementation --- that did not count position correctly for
non-ASCII characters.

Closes #1599
This commit is contained in:
Matthew Flatt 2017-01-30 20:00:07 -07:00
parent 6c9dbea31f
commit 69d7636770
2 changed files with 28 additions and 0 deletions

View File

@ -920,6 +920,31 @@
void))) void)))
exn:fail:read?)) exn:fail:read?))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check whether `read` counts correctly
;; (because `read` may cheat internally with a private "unget")
(let ()
(define p
(let ([in (open-input-string "(…)abcdef")])
(make-input-port
"unicode"
(lambda (s)
(read-bytes-avail!* s in))
(lambda (s skip default)
(peek-bytes-avail!* s skip #f in))
void
#f
#f
#f
void
1)))
(test 0 file-position p)
(void (read p))
(test 5 file-position p)
(test "abcde" read-string 5 p))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs) (report-errs)

View File

@ -3662,6 +3662,9 @@ scheme_ungetc (int ch, Scheme_Object *port)
us[0] = ch; us[0] = ch;
len = scheme_utf8_encode_all(us, 1, e); len = scheme_utf8_encode_all(us, 1, e);
if (ip->p.position > (len - 1))
ip->p.position -= (len - 1);
if (ip->ungotten_count + len >= 24) if (ip->ungotten_count + len >= 24)
scheme_signal_error("ungetc overflow"); scheme_signal_error("ungetc overflow");
while (len) { while (len) {