summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorwelch <welch>1998-10-30 00:38:28 (GMT)
committerwelch <welch>1998-10-30 00:38:28 (GMT)
commit87056a32f65f4451dea20f209b70ca64277453ad (patch)
treef812290afe768219222e9256236b5169d9ba5820
parent4cc4398f8553944112e0594446a0b88c3fa96e7a (diff)
downloadtcl-87056a32f65f4451dea20f209b70ca64277453ad.zip
tcl-87056a32f65f4451dea20f209b70ca64277453ad.tar.gz
tcl-87056a32f65f4451dea20f209b70ca64277453ad.tar.bz2
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"
-rw-r--r--changes7
-rw-r--r--generic/tclIO.c16
-rw-r--r--tests/io.test27
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