Correct the interest masks in the Tcl_CreateFileHandler() calls in PipeWatchProc(). When we are interested in both readable and writable events of a command pipeline channel, we only want the readable from the read end of the pipe, and the writable from the write end of the pipe.

3 files changed, 14 insertions, 13 deletions

diff --git a/generic/tclIO.c b/generic/tclIO.c
index d356e11..7d94037 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -2777,11 +2777,18 @@ FlushChannel(
 	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
 	    ChanWatch(chanPtr, statePtr->interestMask);
 	} else {
-	    /* TODO: If code reaches this point, it means a writable
-	     * event is being handled on the channel, but the channel
-	     * could not in fact be written to.  This ought not happen,
-	     * but Unix pipes appear to act this way (see io-53.4).
-	     * Also can imagine broken reflected channels. */
+
+	    /*
+	     * When we are calledFromAsyncFlush, that means a writable
+	     * state on the channel triggered the call, so we should be
+	     * able to write something.  Either we did write something 
+	     * and wroteSome should be set, or there was nothing left to
+	     * write in this call, and we've completed the BG flush.
+	     * These are the two cases above.  If we get here, that means
+	     * there is some kind failure in the writable event machinery.
+	     */
+
+	    assert(!calledFromAsyncFlush);
 	}
     }
 
diff --git a/tests/io.test b/tests/io.test
index 023af06..96ea14b 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -7144,17 +7144,12 @@ test io-53.4 {CopyData: background write overflow} {stdio unix openpipe fileeven
     for {set x 0} {$x < 12} {incr x} {
 	append big $big
     }
-#    file delete $path(test1)
     file delete $path(pipe)
     set f1 [open $path(pipe) w]
     puts $f1 {
 	puts ready
 	fcopy stdin stdout -command { set x }
 	vwait x
-#	set f [open $path(test1) w]
-#	fconfigure $f -translation lf
-#	puts $f "done"
-#	close $f
     }
     close $f1
     set f1 [open "|[list [interpreter] $path(pipe)]" r+]
@@ -7162,7 +7157,6 @@ test io-53.4 {CopyData: background write overflow} {stdio unix openpipe fileeven
     fconfigure $f1 -blocking 0
     puts $f1 $big
     flush $f1
-    after 500
     set result ""
     fileevent $f1 read [namespace code {
 	append result [read $f1 1024]
diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c
index 9c21b28..a02044e 100644
--- a/unix/tclUnixPipe.c
+++ b/unix/tclUnixPipe.c
@@ -1143,7 +1143,7 @@ PipeWatchProc(
     if (psPtr->inFile) {
 	newmask = mask & (TCL_READABLE | TCL_EXCEPTION);
 	if (newmask) {
-	    Tcl_CreateFileHandler(GetFd(psPtr->inFile), mask,
+	    Tcl_CreateFileHandler(GetFd(psPtr->inFile), newmask,
 		    (Tcl_FileProc *) Tcl_NotifyChannel, psPtr->channel);
 	} else {
 	    Tcl_DeleteFileHandler(GetFd(psPtr->inFile));
@@ -1152,7 +1152,7 @@ PipeWatchProc(
     if (psPtr->outFile) {
 	newmask = mask & (TCL_WRITABLE | TCL_EXCEPTION);
 	if (newmask) {
-	    Tcl_CreateFileHandler(GetFd(psPtr->outFile), mask,
+	    Tcl_CreateFileHandler(GetFd(psPtr->outFile), newmask,
 		    (Tcl_FileProc *) Tcl_NotifyChannel, psPtr->channel);
 	} else {
 	    Tcl_DeleteFileHandler(GetFd(psPtr->outFile));