[894da183c8] Test and fix for regression in flushing blocked channels.

2 files changed, 36 insertions, 2 deletions

diff --git a/generic/tclIO.c b/generic/tclIO.c
index e46a22a..b97f57a 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -2657,6 +2657,8 @@ FlushChannel(
      * the post-condition that on a successful return to caller we've
      * left space in the current output buffer for more writing (the flush
      * call was to make new room).
+     * If the channel is blocking, then yes, so we guarantee that 
+     * blocking flushes actually flush all pending data.
      * Otherwise, no.  Keep the current output buffer where it is so more
      * can be written to it, possibly filling it, to promote more efficient
      * buffer usage.
@@ -2664,7 +2666,8 @@ FlushChannel(
 
     bufPtr = statePtr->curOutPtr;
     if (bufPtr && BytesLeft(bufPtr) && /* Keep empties off queue */
-	    (statePtr->outQueueHead == NULL || IsBufferFull(bufPtr))) {
+	    (statePtr->outQueueHead == NULL || IsBufferFull(bufPtr)
+		    || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) {
 	if (statePtr->outQueueHead == NULL) {
 	    statePtr->outQueueHead = bufPtr;
 	} else {
diff --git a/tests/io.test b/tests/io.test
index 4e1af72..dc98001 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -7388,7 +7388,7 @@ test io-53.4 {CopyData: background write overflow} {stdio unix openpipe fileeven
     set result ""
     fileevent $f1 read [namespace code {
 	append result [read $f1 1024]
-	if {[string length $result] >= [string length $big]} {
+	if {[string length $result] >= [string length $big]+1} {
 	    set x done
 	}
     }]
@@ -7397,6 +7397,37 @@ test io-53.4 {CopyData: background write overflow} {stdio unix openpipe fileeven
     set big {}
     set x
 } done
+test io-53.4.1 {Bug 894da183c8} {stdio fcopy} {
+    set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
+    variable x
+    for {set x 0} {$x < 12} {incr x} {
+	append big $big
+    }
+    file delete $path(pipe)
+    set f1 [open $path(pipe) w]
+    puts $f1 [list file delete $path(test1)]
+    puts $f1 {
+	puts ready
+	set f [open io-53.4.1 w]
+	fcopy stdin $f -command { set x }
+	vwait x
+	close $f
+    }
+    puts $f1 "close \[[list open $path(test1) w]]"
+    close $f1
+    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
+    set result [gets $f1]
+    fconfigure $f1 -blocking 0 -buffersize 125000
+    puts $f1 $big
+    fconfigure $f1 -blocking 1
+    close $f1
+    set big {}
+    while {[catch {glob $path(test1)}]} {after 50}
+    file delete $path(test1)
+    set check [file size io-53.4.1]
+    file delete io-53.4.1
+    set check
+} 266241
 set result {}
 proc FcopyTestAccept {sock args} {
     after 1000 "close $sock"