Attachment "tcl86.diff-wu" to
ticket [2407783fff]
added by
andreas_kupries
2008-12-11 07:37:52.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.4397
diff -w -u -r1.4397 ChangeLog
--- ChangeLog 10 Dec 2008 19:00:53 -0000 1.4397
+++ ChangeLog 11 Dec 2008 00:33:31 -0000
@@ -1,3 +1,12 @@
+2008-12-10 Andreas Kupries <[email protected]>
+
+ * generic/tclIO.c (SetChannelFromAny and related): Modified the
+ 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). [Bug 2407783].
+
2008-12-10 Kevin B. Kenny <[email protected]>
* library/tzdata/*: Update from Olson's tzdata2008i.
Index: generic/tclIO.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIO.c,v
retrieving revision 1.153
diff -w -u -r1.153 tclIO.c
--- generic/tclIO.c 9 Dec 2008 20:16:29 -0000 1.153
+++ generic/tclIO.c 11 Dec 2008 00:33:34 -0000
@@ -222,6 +222,10 @@
((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,10 @@
* currently have an internal rep.*/
{
ChannelState *statePtr = GET_CHANNELSTATE(srcPtr);
+ Interp *interpPtr = GET_CHANNELINTERP(srcPtr);
SET_CHANNELSTATE(copyPtr, statePtr);
+ SET_CHANNELINTERP(copyPtr, interpPtr);
Tcl_Preserve(statePtr);
copyPtr->typePtr = &tclChannelType;
}
@@ -10641,6 +10647,7 @@
register Tcl_Obj *objPtr) /* The object to convert. */
{
ChannelState *statePtr;
+ Interp *interpPtr;
if (objPtr->typePtr == &tclChannelType) {
/*
@@ -10649,11 +10656,16 @@
*/
statePtr = GET_CHANNELSTATE(objPtr);
+ interpPtr = GET_CHANNELINTERP(objPtr);
if (GotFlag(statePtr, CHANNEL_TAINTED|CHANNEL_CLOSED)) {
ResetFlag(statePtr, CHANNEL_TAINTED);
Tcl_Release(statePtr);
UpdateStringOfChannel(objPtr);
objPtr->typePtr = NULL;
+ } else if (interpPtr != (Interp*) interp) {
+ Tcl_Release(statePtr);
+ UpdateStringOfChannel(objPtr);
+ objPtr->typePtr = NULL;
}
}
if (objPtr->typePtr != &tclChannelType) {
@@ -10677,6 +10689,7 @@
statePtr = ((Channel *) chan)->state;
Tcl_Preserve(statePtr);
SET_CHANNELSTATE(objPtr, statePtr);
+ SET_CHANNELINTERP(objPtr, interp);
objPtr->typePtr = &tclChannelType;
}
return TCL_OK;
Index: tests/io.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/io.test,v
retrieving revision 1.91
diff -w -u -r1.91 io.test
--- tests/io.test 20 Jun 2008 20:48:49 -0000 1.91
+++ tests/io.test 11 Dec 2008 00:33:35 -0000
@@ -7695,6 +7695,16 @@
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
