From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Thu, 12 Sep 2013 16:45:50 +0000 (-0700)
Subject: channel-read/write: apply channel-blocking? to a closed channel NOT.
X-Git-Tag: release-9.2.0~115
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1615d0bcaf3230b612459a2c7ad6652aa1ea42d3;p=mit-scheme.git

channel-read/write: apply channel-blocking? to a closed channel NOT.
---

diff --git a/src/runtime/io.scm b/src/runtime/io.scm
index df1da9a02..6ae884913 100644
--- a/src/runtime/io.scm
+++ b/src/runtime/io.scm
@@ -180,9 +180,12 @@ USA.
       (if (eq? n #t)
 	  (begin
 	    (handle-subprocess-status-change)
-	    (if (channel-blocking? channel)
-		(loop)
-		#f))
+	    (without-interrupts
+	     (lambda ()
+	       (if (and (channel-open? channel)
+			(channel-blocking? channel))
+		   (loop)
+		   #f))))
 	  n))))
 
 (define (%channel-read channel buffer start end)
@@ -215,9 +218,12 @@ USA.
       (if (eq? n #t)
 	  (begin
 	    (handle-subprocess-status-change)
-	    (if (channel-blocking? channel)
-		(loop)
-		#f))
+	    (without-interrupts
+	     (lambda ()
+	       (if (and (channel-open? channel)
+			(channel-blocking? channel))
+		   (loop)
+		   #f))))
 	  n))))
 
 (define (%channel-write channel buffer start end)