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)
(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))

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

@ -840,42 +840,46 @@
;; --------------------------------------------------
;; check that commit-based reading counts against a port limit:
(let* ([p (make-limited-input-port
(open-input-string "A\nB\nC\nD\n")
4)]
[N 6]
[chs (for/list ([i N])
(let ([ch (make-channel)])
(thread
(lambda ()
(channel-put ch (list (sync (read-bytes-line-evt p))
(file-position p)))))
ch))]
[r (for/list ([ch chs])
(channel-get ch))])
r)
;; 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]
[chs (for/list ([i N])
(let ([ch (make-channel)])
(thread
(lambda ()
(channel-put ch (list (sync (read-bytes-line-evt p))
(file-position p)))))
ch))]
[r (for/list ([ch chs])
(channel-get ch))])
(test #t list? r)))
;; check proper locking for concurrent access:
(let* ([p (make-limited-input-port
(open-input-string "A\nB\nC\nD\n")
4)]
[N 6]
[chs (for/list ([i N])
(let ([ch (make-channel)])
(thread
(lambda ()
(when (even? i) (sleep))
(channel-put ch (list (sync (read-bytes-line-evt p))
(file-position p)))))
ch))]
[rs (for/list ([ch chs])
(channel-get ch))])
(test 2 apply + (for/list ([r rs]) (if (bytes? (car r)) 1 0)))
(test #t values (for/and ([r rs])
(if (eof-object? (car r))
(eq? (cadr r) 4)
(memq (cadr r) '(2 4))))))
;; check proper locking for concurrent access:
(for ([i 100])
(let* ([p (make-limited-input-port
(open-input-string "A\nB\nC\nD\n")
4)]
[N 6]
[chs (for/list ([i N])
(let ([ch (make-channel)])
(thread
(lambda ()
(when (even? i) (sleep))
(channel-put ch (list (sync (read-bytes-line-evt p))
(file-position p)))))
ch))]
[rs (for/list ([ch chs])
(channel-get ch))])
(test 2 apply + (for/list ([r rs]) (if (bytes? (car r)) 1 0)))
(test #t values (for/and ([r rs])
(if (eof-object? (car r))
(eq? (cadr r) 4)
(and (memq (cadr r) '(2 4)) #t))))))
(let-values ([(in out) (make-pipe-with-specials)])