From 6cb99f7bf8a960b9c8db1d06c4509fea270989b1 Mon Sep 17 00:00:00 2001
From: andreas_kupries <akupries@shaw.ca>
Date: Thu, 11 Dec 2008 17:30:18 +0000
Subject: 	* 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].

---
 ChangeLog       |  9 +++++++++
 generic/tclIO.c | 17 +++++++++++++++--
 tests/io.test   | 12 +++++++++++-
 3 files changed, 35 insertions(+), 3 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 9a39202..07439cc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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  Donal K. Fellows  <dkf@users.sf.net>
 
 	* generic/tclZlib.c (ConvertError): Factor out code to turn zlib
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 09ca6fa..12905de 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.153 2008/12/09 20:16:29 dgp Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.154 2008/12/11 17:30:18 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -222,6 +222,10 @@ static const 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)) || \
@@ -10611,9 +10615,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(statePtr);
     copyPtr->typePtr = &tclChannelType;
 }
@@ -10641,6 +10647,7 @@ SetChannelFromAny(
     register Tcl_Obj *objPtr)	/* The object to convert. */
 {
     ChannelState *statePtr;
+    Interp       *interpPtr;
 
     if (objPtr->typePtr == &tclChannelType) {
 	/*
@@ -10649,11 +10656,16 @@ SetChannelFromAny(
 	 */
 
 	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 @@ SetChannelFromAny(
 	statePtr = ((Channel *) chan)->state;
 	Tcl_Preserve(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 d6ed830..9f41db0 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.91 2008/06/20 20:48:49 dgp Exp $
+# RCS: @(#) $Id: io.test,v 1.92 2008/12/11 17:30:18 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
-- 
cgit v0.12