[c31ca233ca] Fix TclGetsObjBinary() so that each [gets] rediscovers whether

a nonblocking channel is blocked.

2 files changed, 24 insertions, 5 deletions

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 85b015c..9deec87 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4377,11 +4377,6 @@ TclGetsObjBinary(
 	     * hasn't seen EOL. Need to read more bytes from the channel
 	     * device. Side effect is to allocate another channel buffer.
 	     */
-
-	    if (GotFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_NONBLOCKING)
-		    == (CHANNEL_BLOCKED|CHANNEL_NONBLOCKING)) {
-		goto restore;
-	    }
 	    if (GetInput(chanPtr) != 0) {
 		goto restore;
 	    }
@@ -4448,6 +4443,10 @@ TclGetsObjBinary(
 	    }
 	    goto gotEOL;
 	}
+	if (GotFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_NONBLOCKING)
+		== (CHANNEL_BLOCKED|CHANNEL_NONBLOCKING)) {
+	    goto restore;
+	}
 
 	/*
 	 * Copy bytes from the channel buffer to the ByteArray.
diff --git a/tests/io.test b/tests/io.test
index a1625ba..c1938a1 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -4921,6 +4921,26 @@ test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio openpipe} {
     close $f1
     set x
 } {{} 1 hello 0 {} 1}
+test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} {stdio openpipe} {
+    set f1 [open "|[list [interpreter]]" r+]
+    chan configure $f1 -encoding binary -translation lf -eofchar {}
+    puts $f1 {puts hello_from_pipe}
+    flush $f1
+    gets $f1
+    fconfigure $f1 -blocking off -buffering full
+    puts $f1 {puts hello}
+    set x ""
+    lappend x [gets $f1]
+    lappend x [fblocked $f1]
+    flush $f1
+    after 200
+    lappend x [gets $f1]
+    lappend x [fblocked $f1]
+    lappend x [gets $f1]
+    lappend x [fblocked $f1]
+    close $f1
+    set x
+} {{} 1 hello 0 {} 1}
 test io-36.2 {Tcl_InputBlocked on blocking pipe} {stdio openpipe} {
     set f1 [open "|[list [interpreter]]" r+]
     fconfigure $f1 -buffering line