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

racket/port: fix problems with `read-bytes!-evt'

Browse Source 
See PR 12860; some of problem related to the PR were "fixed" by
adjusting the guarantees that are specified in the documentation.

Another problem was that non-consecutive bytes could be returned.

original commit: c11527494ed3a08d1ea6caf8e7ec6661f2505ef7
This commit is contained in:
Matthew Flatt 2012-06-24 07:22:13 -06:00
parent 71e83fb930
commit c53585429a
1 changed files with 19 additions and 10 deletions

29
collects/mzlib/port.rkt
View File

@ -959,21 +959,30 @@
;; go is the main reading function, either called directly for ;; go is the main reading function, either called directly for
;; a poll, or called in a thread for a non-poll read ;; a poll, or called in a thread for a non-poll read
(define (go nack ch poll?) (define (go nack ch poll?)
(let try-again ([pos 0][bstr orig-bstr]) (let try-again ([pos 0] [bstr orig-bstr] [progress-evt #f])
(let* ([progress-evt (or prog-evt (port-progress-evt input-port))] (let* ([progress-evt
[v ((if poll? peek-bytes-avail!* peek-bytes-avail!) ;; if no progress event is given, get one to ensure that
bstr (+ pos (or peek-offset 0)) progress-evt input-port pos)]) ;; consecutive bytes are read and can be committed:
(or progress-evt prog-evt (port-progress-evt input-port))]
[v (and
;; to implement weak support for reusing the buffer in `read-bytes!-evt',
;; need to check nack after getting progress-evt:
(not (sync/timeout 0 nack))
;; try to get bytes:
((if poll? peek-bytes-avail!* peek-bytes-avail!)
bstr (+ pos (or peek-offset 0)) progress-evt input-port pos))])
(cond (cond
;; the first two cases below are shortcuts, and not ;; the first two cases below are shortcuts, and not
;; strictly necessary ;; strictly necessary
[(sync/timeout 0 nack) (void)] [(sync/timeout 0 nack)
(void)]
[(sync/timeout 0 progress-evt) [(sync/timeout 0 progress-evt)
(cond [poll? #f] (cond [poll? #f]
[prog-evt (void)] [prog-evt (void)]
[else (try-again pos bstr)])] [else (try-again 0 bstr #f)])]
[(and poll? (equal? v 0)) #f] [(and poll? (equal? v 0)) #f]
[(and (number? v) (need-more? bstr (+ pos v))) [(and (number? v) (need-more? bstr (+ pos v)))
=> (lambda (bstr) (try-again (+ v pos) bstr))] => (lambda (bstr) (try-again (+ v pos) bstr progress-evt))]
[else [else
(let* ([v2 (cond [(number? v) (shrink bstr (+ v pos))] (let* ([v2 (cond [(number? v) (shrink bstr (+ v pos))]
[(positive? pos) pos] [(positive? pos) pos]
@ -999,7 +1008,7 @@
(let ([result (combo bstr eof)]) (let ([result (combo bstr eof)])
(if poll? result (channel-put ch result)))] (if poll? result (channel-put ch result)))]
[poll? #f] [poll? #f]
[else (try-again 0 orig-bstr)]))])))) [else (try-again 0 orig-bstr #f)]))]))))
(if (zero? (bytes-length orig-bstr)) (if (zero? (bytes-length orig-bstr))
(wrap-evt always-evt (lambda (x) 0)) (wrap-evt always-evt (lambda (x) 0))
(poll-or-spawn go))) (poll-or-spawn go)))
@ -1025,8 +1034,8 @@
(lambda (bstr v) v) (lambda (bstr v) v)
peek-offset prog-evt)) peek-offset prog-evt))
(define (read-bytes!-evt bstr input-port) (define (read-bytes!-evt bstr input-port [progress-evt #f])
(-read-bytes!-evt bstr input-port #f #f)) (-read-bytes!-evt bstr input-port #f progress-evt))
(define (peek-bytes!-evt bstr peek-offset prog-evt input-port) (define (peek-bytes!-evt bstr peek-offset prog-evt input-port)
(-read-bytes!-evt bstr input-port peek-offset prog-evt)) (-read-bytes!-evt bstr input-port peek-offset prog-evt))