racket/port: fix `make-limited-input-port' handling of progress evts

Merge to v5.3
This commit is contained in:
Matthew Flatt 2012-07-25 21:37:58 -06:00
parent d1048406b5
commit ca3272bd45
2 changed files with 43 additions and 36 deletions

View File

@ -1000,7 +1000,10 @@
(define (do-peek str skip progress-evt)
(let ([count (max 0 (min (- limit got skip) (bytes-length str)))])
(if (zero? count)
eof
(if (and progress-evt
(sync/timeout 0 progress-evt))
#f
eof)
(let ([n (peek-bytes-avail!* str skip progress-evt port 0 count)])
(if (eq? n 0)
(wrap-evt port (lambda (x) 0))

View File

@ -840,8 +840,11 @@
;; --------------------------------------------------
;; check that commit-based reading counts against a port limit:
(let* ([p (make-limited-input-port
;; check that commit-based reading counts against a port limit;
;; this test also checks an interaction of `make-limited-input-port'
;; and progress evts, so run it several times
(for ([i 100])
(let* ([p (make-limited-input-port
(open-input-string "A\nB\nC\nD\n")
4)]
[N 6]
@ -854,10 +857,11 @@
ch))]
[r (for/list ([ch chs])
(channel-get ch))])
r)
(test #t list? r)))
;; check proper locking for concurrent access:
(let* ([p (make-limited-input-port
(for ([i 100])
(let* ([p (make-limited-input-port
(open-input-string "A\nB\nC\nD\n")
4)]
[N 6]
@ -875,7 +879,7 @@
(test #t values (for/and ([r rs])
(if (eof-object? (car r))
(eq? (cadr r) 4)
(memq (cadr r) '(2 4))))))
(and (memq (cadr r) '(2 4)) #t))))))
(let-values ([(in out) (make-pipe-with-specials)])