From 6652de82ba5502a042b2be29a5cf7e04b73fca4b Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 9 Sep 2013 13:34:06 +0000
Subject: [3609693] Must strip the internal representation of procedure-like
 methods in order to ensure that any bound references to instance variables
 are removed.

---
 generic/tclOOMethod.c | 50 ++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 48 insertions(+), 2 deletions(-)

diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 81293c7..61215de 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -1290,11 +1290,57 @@ CloneProcedureMethod(
     ClientData *newClientData)
 {
     ProcedureMethod *pmPtr = clientData;
-    ProcedureMethod *pm2Ptr = ckalloc(sizeof(ProcedureMethod));
+    ProcedureMethod *pm2Ptr;
+    Tcl_Obj *bodyObj, *argsObj;
+    CompiledLocal *localPtr;
 
+    /*
+     * Copy the argument list.
+     */
+
+    argsObj = Tcl_NewObj();
+    for (localPtr=pmPtr->procPtr->firstLocalPtr; localPtr!=NULL;
+	    localPtr=localPtr->nextPtr) {
+	if (TclIsVarArgument(localPtr)) {
+	    Tcl_Obj *argObj = Tcl_NewObj();
+
+	    Tcl_ListObjAppendElement(NULL, argObj,
+		    Tcl_NewStringObj(localPtr->name, -1));
+	    if (localPtr->defValuePtr != NULL) {
+		Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
+	    }
+	    Tcl_ListObjAppendElement(NULL, argsObj, argObj);
+	}
+    }
+
+    /*
+     * Must strip the internal representation in order to ensure that any
+     * bound references to instance variables are removed. [Bug 3609693]
+     */
+
+    bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr);
+    TclFreeIntRep(bodyObj);
+
+    /*
+     * Create the actual copy of the method record, manufacturing a new proc
+     * record.
+     */
+
+    pm2Ptr = ckalloc(sizeof(ProcedureMethod));
     memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod));
     pm2Ptr->refCount = 1;
-    pm2Ptr->procPtr->refCount++;
+    Tcl_IncrRefCount(argsObj);
+    Tcl_IncrRefCount(bodyObj);
+    if (TclCreateProc(interp, NULL, "", argsObj, bodyObj,
+	    &pm2Ptr->procPtr) != TCL_OK) {
+	Tcl_DecrRefCount(argsObj);
+	Tcl_DecrRefCount(bodyObj);
+	ckfree(pm2Ptr);
+	return TCL_ERROR;
+    }
+    Tcl_DecrRefCount(argsObj);
+    Tcl_DecrRefCount(bodyObj);
+
     if (pmPtr->cloneClientdataProc) {
 	pm2Ptr->clientData = pmPtr->cloneClientdataProc(pmPtr->clientData);
     }
-- 
cgit v0.12