Fixed the Tcl_NotifyChannel bug, plus added a test case for it.

Simply replaced Tcl_RegisterChannel/UnregisterChannel with
Tcl_Preserve/Tcl_Release was all it took.  Chanels are already
"eventually freed"

3 files changed, 36 insertions, 14 deletions

diff --git a/changes b/changes
index 0ef6d93..000355c 100644
--- a/changes
+++ b/changes
@@ -1,6 +1,6 @@
 Recent user-visible changes to Tcl:
 
-RCS: @(#) $Id: changes,v 1.29 1998/10/23 22:22:02 welch Exp $
+RCS: @(#) $Id: changes,v 1.30 1998/10/30 00:38:28 welch Exp $
 
 1. No more [command1] [command2] construct for grouping multiple
 commands on a single command line.
@@ -3655,3 +3655,8 @@ it searched for the initialization script.  tclInitScript.h was incorrectly
 adding the parent of tcl_library to tcl_pkgPath.  This logic was moved
 into init.tcl, and the initialization of auto_path was documented.
 Thanks to Donald Porter and Tom Silva for related patches. (BW)
+
+10/29/98 (bug fix) Fixed Tcl_NotifyChannel to use Tcl_Preserve instead
+of Tcl_RegisterChannel so that 1) unregistered channels do not get
+closed after their first fileevent, and 2) errors that occur during
+close in a fileevent script are actually reflected by the close command. (BW)
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 6de1151..9725902 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIO.c,v 1.4 1998/09/14 18:39:59 stanton Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.5 1998/10/30 00:38:38 welch Exp $
  */
 
 #include	"tclInt.h"
@@ -4520,13 +4520,10 @@ Tcl_NotifyChannel(channel, mask)
     NextChannelHandler nh;
 
     /*
-     * Prevent the event handler from deleting the channel by incrementing
-     * the channel's ref count.  Case in point: ChannelEventScriptInvoker()
-     * was evaling a script (owned by the channel) which caused the channel
-     * to be closed and then the byte codes no longer existed.
+     * Preserve the channel struct in case the script closes it.
      */
      
-    Tcl_RegisterChannel((Tcl_Interp *) NULL, channel);
+    Tcl_Preserve((ClientData) channel);
 
     /*
      * If we are flushing in the background, be sure to call FlushChannel
@@ -4574,12 +4571,7 @@ Tcl_NotifyChannel(channel, mask)
 	UpdateInterest(chanPtr);
     }
 
-    /*
-     * No longer need to protect the channel from being deleted.
-     * After this point it is unsafe to use the value of "channel".
-     */
- 
-    Tcl_UnregisterChannel((Tcl_Interp *) NULL, channel);
+    Tcl_Release((ClientData) channel);
 
     nestedHandlerPtr = nh.nestedHandlerPtr;
 }
diff --git a/tests/io.test b/tests/io.test
index 6e82dd3..583e333 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: io.test,v 1.4 1998/09/14 18:40:10 stanton Exp $
+# RCS: @(#) $Id: io.test,v 1.5 1998/10/30 00:38:39 welch Exp $
 
 if {[string compare test [info procs test]] == 1} then {source defs}
 
@@ -5169,6 +5169,31 @@ test io-34.2 {buffered data and file events, read} {
     set result
 } {1 readable 234567890 timer}
         
+test io-35.1 {Tcl_NotifyChannel and error when closing} {unixOrPc} {
+    set out [open script w]
+    puts $out {
+	puts "normal message from pipe"
+	puts stderr "error message from pipe"
+	exit 1
+    }
+    proc readit {pipe} {
+	global x result
+	if {[eof $pipe]} {
+	    set x [catch {close $pipe} line]
+	    lappend result catch $line
+	} else {
+	    gets $pipe line
+	    lappend result gets $line
+	}
+    }
+    close $out
+    set pipe [open "|$tcltest script" r]
+    fileevent $pipe readable [list readit $pipe]
+    set x ""
+    set result ""
+    vwait x
+    list $x $result
+} {1 {gets {normal message from pipe} gets {} catch {error message from pipe}}}
 
 
 removeFile fooBar