diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | generic/tclIO.c | 20 | ||||
| -rw-r--r-- | tests/io.test | 12 |
3 files changed, 37 insertions, 4 deletions
@@ -1,3 +1,12 @@ +2008-12-11 Andreas Kupries <andreask@activestate.com> + + * generic/tclIO.c (SetChannelFromAny and related): Modified the + * tests/io.test: internal representation of the tclChannelType to + contain not only the ChannelState pointer, but also a reference to + the interpreter it was made in. Invalidate and recompute the + internal representation when it is used in a different interpreter + (Like cmdName intrep's). Added testcase. [Bug 2407783]. + 2008-12-11 Jan Nijtmans <nijtmans@users.sf.net> * library/clock.tcl (ProcessPosixTimeZone): Fallback to diff --git a/generic/tclIO.c b/generic/tclIO.c index 2e8b7dc..3553286 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.137.2.9 2008/12/02 18:23:51 andreas_kupries Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.137.2.10 2008/12/11 17:27:39 andreas_kupries Exp $ */ #include "tclInt.h" @@ -220,6 +220,10 @@ static Tcl_ObjType tclChannelType = { ((ChannelState *) (objPtr)->internalRep.otherValuePtr) #define SET_CHANNELSTATE(objPtr, storePtr) \ ((objPtr)->internalRep.otherValuePtr = (void *) (storePtr)) +#define GET_CHANNELINTERP(objPtr) \ + ((Interp *) (objPtr)->internalRep.twoPtrValue.ptr2) +#define SET_CHANNELINTERP(objPtr, storePtr) \ + ((objPtr)->internalRep.twoPtrValue.ptr2 = (void *) (storePtr)) #define BUSY_STATE(st,fl) \ ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \ @@ -10612,8 +10616,11 @@ DupChannelIntRep( register Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not * currently have an internal rep.*/ { - ChannelState *statePtr = GET_CHANNELSTATE(srcPtr); + ChannelState *statePtr = GET_CHANNELSTATE(srcPtr); + Interp *interpPtr = GET_CHANNELINTERP(srcPtr); + SET_CHANNELSTATE(copyPtr, statePtr); + SET_CHANNELINTERP(copyPtr, interpPtr); Tcl_Preserve((ClientData) statePtr); copyPtr->typePtr = &tclChannelType; } @@ -10641,18 +10648,24 @@ SetChannelFromAny( register Tcl_Obj *objPtr) /* The object to convert. */ { ChannelState *statePtr; + Interp *interpPtr; if (objPtr->typePtr == &tclChannelType) { /* * The channel is valid until any call to DetachChannel occurs. * Ensure consistency checks are done. */ - statePtr = GET_CHANNELSTATE(objPtr); + statePtr = GET_CHANNELSTATE(objPtr); + interpPtr = GET_CHANNELINTERP(objPtr); if (statePtr->flags & (CHANNEL_TAINTED|CHANNEL_CLOSED)) { ResetFlag(statePtr, CHANNEL_TAINTED); Tcl_Release((ClientData) statePtr); UpdateStringOfChannel(objPtr); objPtr->typePtr = NULL; + } else if (interpPtr != (Interp*) interp) { + Tcl_Release((ClientData) statePtr); + UpdateStringOfChannel(objPtr); + objPtr->typePtr = NULL; } } if (objPtr->typePtr != &tclChannelType) { @@ -10675,6 +10688,7 @@ SetChannelFromAny( statePtr = ((Channel *)chan)->state; Tcl_Preserve((ClientData) statePtr); SET_CHANNELSTATE(objPtr, statePtr); + SET_CHANNELINTERP(objPtr, interp); objPtr->typePtr = &tclChannelType; } return TCL_OK; diff --git a/tests/io.test b/tests/io.test index a2aaf7f..2e21e5b 100644 --- a/tests/io.test +++ b/tests/io.test @@ -13,7 +13,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.80.2.12 2008/06/20 19:23:26 dgp Exp $ +# RCS: @(#) $Id: io.test,v 1.80.2.13 2008/12/11 17:27:39 andreas_kupries Exp $ if {[catch {package require tcltest 2}]} { puts stderr "Skipping tests in [info script]. tcltest 2 required." @@ -7695,6 +7695,16 @@ test io-73.1 {channel Tcl_Obj SetChannelFromAny} {} { catch {close [lreplace [list a] 0 end]} } {1} +test io-73.2 {channel Tcl_Obj SetChannelFromAny, bug 2407783} {} { + # Invalidate intrep of 'channel' Tcl_Obj when transiting between interpreters. + interp create foo + set f [open [info script] r] + seek $f 0 + set code [catch {interp eval foo [list seek $f 0]} msg] + # The string map converts the changing channel handle to a fixed string + list $code [string map [list $f @@] $msg] +} {1 {can not find channel named "@@"}} + # ### ### ### ######### ######### ######### # cleanup |