Index: doc/close.n
==================================================================
--- doc/close.n
+++ doc/close.n
@@ -46,12 +46,14 @@
 When the last interpreter in which the channel is registered invokes
 \fBclose\fR, the cleanup actions described above occur. See the
 \fBinterp\fR command for a description of channel sharing.
 .PP
 Channels are automatically closed when an interpreter is destroyed and
-when the process exits.  Channels are switched to blocking mode, to ensure
-that all output is correctly flushed before the process exits.
+when the process exits.
+.VS 8.6
+From 8.6 on (TIP#398), nonblocking channels are no longer switched to blocking mode when exiting; this guarantees a timely exit even when the peer or a communication channel is stalled. To ensure proper flushing of stalled nonblocking channels on exit, one must now either (a) actively switch them back to blocking or (b) use the environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT,  which when set and not equal to "0" restores the previous behavior.
+.VE 8.6
 .PP
 The command returns an empty string, and may generate an error if
 an error occurs while flushing output.  If a command in a command
 pipeline created with \fBopen\fR returns an error, \fBclose\fR
 generates an error (similar to the \fBexec\fR command.)

Index: generic/tclIO.c
==================================================================
--- generic/tclIO.c
+++ generic/tclIO.c
@@ -394,10 +394,23 @@
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     Channel *chanPtr = NULL;	/* Iterates over open channels. */
     ChannelState *statePtr;	/* State of channel stack */
     int active = 1;		/* Flag == 1 while there's still work to do */
+    int doflushnb;
+
+    /* Fetch the pre-TIP#398 compatibility flag */ 
+    {
+        const char *s;
+        Tcl_DString ds;
+        
+        s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds);
+        doflushnb = ((s != NULL) && strcmp(s, "0"));
+        if (s != NULL) {
+            Tcl_DStringFree(&ds);
+        }
+    }
 
     /*
      * Walk all channel state structures known to this thread and close
      * corresponding channels.
      */
@@ -412,12 +425,12 @@
 	active = 0;
 	for (statePtr = tsdPtr->firstCSPtr;
 		statePtr != NULL;
 		statePtr = statePtr->nextCSPtr) {
 	    chanPtr = statePtr->topChanPtr;
-            if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED | CHANNEL_DEAD)
-                || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+	    if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED | CHANNEL_DEAD)
+                || (doflushnb && GotFlag(statePtr, BG_FLUSH_SCHEDULED))) {
 		active = 1;
 		break;
 	    }
 	}
 
@@ -424,17 +437,25 @@
 	/*
 	 * We've found a live channel. Close it.
 	 */
 
 	if (active) {
+
 	    /*
-	     * Set the channel back into blocking mode to ensure that we wait
-	     * for all data to flush out.
+	     * TIP #398:  by default, we no  longer set the  channel back into
+             * blocking  mode.  To  restore  the old  blocking  behavior,  the
+             * environment variable  TCL_FLUSH_NONBLOCKING_ON_EXIT must be set
+             * and not be "0".
 	     */
-
-	    (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
-		    "-blocking", "on");
+            if (doflushnb) {
+                    /* Set the channel back into blocking mode to ensure that we wait
+                     * for all data to flush out.
+                     */
+                
+                (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
+                                            "-blocking", "on");                    
+            }
 
 	    if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
 		    (chanPtr == (Channel *) tsdPtr->stdoutChannel) ||
 		    (chanPtr == (Channel *) tsdPtr->stderrChannel)) {
 		/*

Index: tests/io.test
==================================================================
--- tests/io.test
+++ tests/io.test
@@ -2734,10 +2734,29 @@
     set f [open $path(test1) r]
     set r [read $f]
     close $f
     set r
 } "hello\nbye\nstrange\n"
+set path(script2) [makeFile {} script2]
+test io-29.33b {TIP#398, no implicit flush of nonblocking on exit} {exec} {
+    set f [open $path(script) w]
+    puts $f {
+		fconfigure stdout -blocking 0
+		puts -nonewline stdout [string repeat A 655360]
+		flush stdout
+	}
+    close $f
+    set f [open $path(script2) w]
+    puts $f {after 2000}
+    close $f
+	set t1 [clock seconds]
+	set ff [open "|[list [interpreter] $path(script2)]" w]
+	exec [interpreter] $path(script) >@ $ff
+	set t2 [clock seconds]
+	close $ff
+	expr {($t2-$t1)/2}
+} 0
 test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac fileevent} {
     variable c 0
     variable x running
     set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
     proc writelots {s l} {
@@ -7759,13 +7778,13 @@
 } -result {1 {can not find channel named "@@"}}
 
 # ### ### ### ######### ######### #########
 
 # cleanup
-foreach file [list fooBar longfile script output test1 pipe my_script \
+foreach file [list fooBar longfile script script2 output test1 pipe my_script \
 	test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
     removeFile $file
 }
 cleanupTests
 }
 namespace delete ::tcl::test::io
 return