diff --git a/pkgs/racket-test-core/tests/racket/port.rktl b/pkgs/racket-test-core/tests/racket/port.rktl index ada754c2a3..6b06706ae5 100644 --- a/pkgs/racket-test-core/tests/racket/port.rktl +++ b/pkgs/racket-test-core/tests/racket/port.rktl @@ -920,6 +920,31 @@ void))) 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) diff --git a/racket/src/racket/src/port.c b/racket/src/racket/src/port.c index 7f5b1130a4..5613de63dc 100644 --- a/racket/src/racket/src/port.c +++ b/racket/src/racket/src/port.c @@ -3662,6 +3662,9 @@ scheme_ungetc (int ch, Scheme_Object *port) us[0] = ch; 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) scheme_signal_error("ungetc overflow"); while (len) {