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

Fixing problem report 10261 by stopping when ip is closed

Browse Source 
svn: r15095

original commit: 10dc76439835021fc5250f38dfa1ecd24355982f
This commit is contained in:
Jay McCarthy 2009-06-05 17:36:50 +00:00
parent 65b38b778b
commit 1a25902f9a
1 changed files with 39 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
collects/mzlib/port.ss
View File

@ -1023,43 +1023,45 @@
(define (regexp-match-evt pattern input-port) (define (regexp-match-evt pattern input-port)
(define (go nack ch poll?) (define (go nack ch poll?)
(let try-again () (let try-again ()
(let* ([progress-evt (port-progress-evt input-port)] (if (port-closed? input-port)
[m ((if poll? #f
regexp-match-peek-positions-immediate (let* ([progress-evt (port-progress-evt input-port)]
regexp-match-peek-positions) [m ((if poll?
pattern input-port 0 #f progress-evt)]) regexp-match-peek-positions-immediate
(cond regexp-match-peek-positions)
[(sync/timeout 0 nack) (void)] pattern input-port 0 #f progress-evt)])
[(sync/timeout 0 progress-evt) (try-again)] (cond
[(not m) [(sync/timeout 0 nack) (void)]
(if poll? [(sync/timeout 0 progress-evt) (try-again)]
#f [(not m)
(sync nack (if poll?
(handle-evt progress-evt #f
(lambda (x) (try-again)))))] (sync nack
[else (handle-evt progress-evt
(let ([m2 (map (lambda (p) (lambda (x) (try-again)))))]
(and p [else
(let ([bstr (make-bytes (- (cdr p) (car p)))]) (let ([m2 (map (lambda (p)
(unless (= (car p) (cdr p)) (and p
(let loop ([offset 0]) (let ([bstr (make-bytes (- (cdr p) (car p)))])
(let ([v (peek-bytes-avail! bstr (car p) progress-evt input-port offset)]) (unless (= (car p) (cdr p))
(unless (zero? v) (let loop ([offset 0])
(when ((+ offset v) . < . (bytes-length bstr)) (let ([v (peek-bytes-avail! bstr (car p) progress-evt input-port offset)])
(loop (+ offset v))))))) (unless (zero? v)
bstr))) (when ((+ offset v) . < . (bytes-length bstr))
m)]) (loop (+ offset v)))))))
(cond bstr)))
[(and (zero? (cdar m)) (or poll? (channel-put ch m2))) m)])
m2] (cond
[(port-commit-peeked [(and (zero? (cdar m)) (or poll? (channel-put ch m2)))
(cdar m) m2]
progress-evt [(port-commit-peeked
(if poll? always-evt (channel-put-evt ch m2)) (cdar m)
input-port) progress-evt
m2] (if poll? always-evt (channel-put-evt ch m2))
[poll? #f] input-port)
[else (try-again)]))])))) m2]
[poll? #f]
[else (try-again)]))])))))
(poll-or-spawn go)) (poll-or-spawn go))
(define-syntax (newline-rx stx) (define-syntax (newline-rx stx)