From 1a25902f9a45b451a234a0822a596b068581e3f9 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Fri, 5 Jun 2009 17:36:50 +0000
Subject: [PATCH] Fixing problem report 10261 by stopping when ip is closed

svn: r15095

original commit: 10dc76439835021fc5250f38dfa1ecd24355982f
---
 collects/mzlib/port.ss | 76 ++++++++++++++++++++++--------------------
 1 file changed, 39 insertions(+), 37 deletions(-)

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