diff options
| -rw-r--r-- | changes | 7 | ||||
| -rw-r--r-- | generic/tclIO.c | 16 | ||||
| -rw-r--r-- | tests/io.test | 27 |
3 files changed, 36 insertions, 14 deletions
@@ -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 |