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

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

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