Attachment "tcl85.diff-wu" to
ticket [2407783fff]
added by
andreas_kupries
2008-12-11 07:37:08.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcl/tcl/ChangeLog,v
retrieving revision 1.3975.2.134
diff -w -u -r1.3975.2.134 ChangeLog
--- ChangeLog 10 Dec 2008 19:03:58 -0000 1.3975.2.134
+++ ChangeLog 11 Dec 2008 00:33:28 -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.137.2.9
diff -w -u -r1.137.2.9 tclIO.c
--- generic/tclIO.c 2 Dec 2008 18:23:51 -0000 1.137.2.9
+++ generic/tclIO.c 11 Dec 2008 00:33:29 -0000
@@ -220,6 +220,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)) || \
@@ -10613,7 +10617,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((ClientData) statePtr);
copyPtr->typePtr = &tclChannelType;
}
@@ -10641,6 +10648,7 @@
register Tcl_Obj *objPtr) /* The object to convert. */
{
ChannelState *statePtr;
+ Interp *interpPtr;
if (objPtr->typePtr == &tclChannelType) {
/*
@@ -10648,11 +10656,16 @@
* Ensure consistency checks are done.
*/
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 @@
statePtr = ((Channel *)chan)->state;
Tcl_Preserve((ClientData) 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.80.2.12
diff -w -u -r1.80.2.12 io.test
--- tests/io.test 20 Jun 2008 19:23:26 -0000 1.80.2.12
+++ tests/io.test 11 Dec 2008 00:33:29 -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
