suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/racket/port.rkt
View File

@ -1000,7 +1000,10 @@
(define (do-peek str skip progress-evt) (define (do-peek str skip progress-evt)
(let ([count (max 0 (min (- limit got skip) (bytes-length str)))]) (let ([count (max 0 (min (- limit got skip) (bytes-length str)))])
(if (zero? count) (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)]) (let ([n (peek-bytes-avail!* str skip progress-evt port 0 count)])
(if (eq? n 0) (if (eq? n 0)
(wrap-evt port (lambda (x) 0)) (wrap-evt port (lambda (x) 0))

14
collects/tests/racket/portlib.rktl
View File

@ -840,8 +840,11 @@
;; -------------------------------------------------- ;; --------------------------------------------------
;; check that commit-based reading counts against a port limit: ;; check that commit-based reading counts against a port limit;
(let* ([p (make-limited-input-port ;; 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") (open-input-string "A\nB\nC\nD\n")
4)] 4)]
[N 6] [N 6]
@ -854,10 +857,11 @@
ch))] ch))]
[r (for/list ([ch chs]) [r (for/list ([ch chs])
(channel-get ch))]) (channel-get ch))])
r) (test #t list? r)))
;; check proper locking for concurrent access: ;; 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") (open-input-string "A\nB\nC\nD\n")
4)] 4)]
[N 6] [N 6]
@ -875,7 +879,7 @@
(test #t values (for/and ([r rs]) (test #t values (for/and ([r rs])
(if (eof-object? (car r)) (if (eof-object? (car r))
(eq? (cadr r) 4) (eq? (cadr r) 4)
(memq (cadr r) '(2 4)))))) (and (memq (cadr r) '(2 4)) #t))))))
(let-values ([(in out) (make-pipe-with-specials)]) (let-values ([(in out) (make-pipe-with-specials)])