* generic/tclProc.c (ProcCompileProc): When a bump of the compile

        epoch forces the re-compile of a proc body, take care not to
        overwrite any Proc struct that may be referred to on the active
        call stack.  This fixes [Bug 148218].  Note that the fix will not be
        effective for code that calls the private routine TclProcCompileProc()
        directly.

2 files changed, 92 insertions, 5 deletions

diff --git a/ChangeLog b/ChangeLog
index e0a91a3..010359d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2006-05-13  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclProc.c (ProcCompileProc):	When a bump of the compile
+	epoch forces the re-compile of a proc body, take care not to
+	overwrite any Proc struct that may be referred to on the active
+	call stack.  This fixes [Bug 148218].  Note that the fix will not be
+	effective for code that calls the private routine TclProcCompileProc()
+	directly.
+
 2006-05-13  Daniel Steffen  <das@users.sourceforge.net>
 
 	* generic/tclEvent.c (HandleBgErrors): fix leak. [Coverity issue 86]
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 227c4fc..200a6b6 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclProc.c,v 1.89 2006/03/16 09:56:46 das Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.90 2006/05/13 17:14:26 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -37,6 +37,10 @@ static int		ProcessProcResultCode(Tcl_Interp *interp,
 static int		SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 static int		TclCompileNoOp(Tcl_Interp *interp, Tcl_Parse *parsePtr,
 			    struct CompileEnv *envPtr);
+static int		ProcCompileProc (Tcl_Interp *interp, Proc *procPtr,
+			    Tcl_Obj *bodyPtr, Namespace *nsPtr, 
+			    CONST char *description, CONST char *procName,
+			    Proc **procPtrPtr);
 
 /*
  * The ProcBodyObjType type
@@ -1156,7 +1160,7 @@ ObjInterpProcEx(
     int skip)			/* Number of initial arguments to be skipped,
 				 * ie, words in the "command name" */ 
 {
-    register Proc *procPtr = (Proc *) clientData;
+    Proc *procPtr = (Proc *) clientData;
     Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
     CallFrame *framePtr, **framePtrPtr;
     register Var *varPtr;
@@ -1179,8 +1183,8 @@ ObjInterpProcEx(
      * local variables are found while compiling.
      */
 
-    result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
-	    "body of proc", procName);
+    result = ProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
+	    "body of proc", procName, &procPtr);
 
     if (result != TCL_OK) {
 	return result;
@@ -1475,11 +1479,29 @@ TclProcCompileProc(
     CONST char *description,	/* string describing this body of code. */
     CONST char *procName)	/* Name of this procedure. */
 {
+    return ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
+	    procName, NULL);
+}
+
+static int
+ProcCompileProc(
+    Tcl_Interp *interp,		/* Interpreter containing procedure. */
+    Proc *procPtr,		/* Data associated with procedure. */
+    Tcl_Obj *bodyPtr,		/* Body of proc. (Usually procPtr->bodyPtr,
+ 				 * but could be any code fragment compiled in
+ 				 * the context of this procedure.) */
+    Namespace *nsPtr,		/* Namespace containing procedure. */
+    CONST char *description,	/* string describing this body of code. */
+    CONST char *procName,	/* Name of this procedure. */
+    Proc **procPtrPtr)		/* Points to storage where a replacement
+				 * (Proc *) value may be written. */
+{
     Interp *iPtr = (Interp*)interp;
-    int result;
+    int i, result;
     Tcl_CallFrame *framePtr;
     Proc *saveProcPtr;
     ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
+    CompiledLocal *localPtr;
 
     /*
      * If necessary, compile the procedure's body. The compiler will allocate
@@ -1542,6 +1564,62 @@ TclProcCompileProc(
  	 */
 
  	saveProcPtr = iPtr->compiledProcPtr;
+
+	if (procPtrPtr != NULL && procPtr->refCount > 1) {
+	    Tcl_Command token;
+	    Tcl_CmdInfo info;
+	    Proc *new = (Proc *) ckalloc(sizeof(Proc));
+
+	    new->iPtr = procPtr->iPtr;
+	    new->refCount = 1;
+	    token = (Tcl_Command) new->cmdPtr = procPtr->cmdPtr;
+	    new->bodyPtr = Tcl_DuplicateObj(bodyPtr);
+	    bodyPtr = new->bodyPtr;
+	    Tcl_IncrRefCount(bodyPtr);
+	    new->numArgs = procPtr->numArgs;
+
+	    new->numCompiledLocals = new->numArgs;
+	    new->firstLocalPtr = NULL;
+	    new->lastLocalPtr = NULL;
+	    localPtr = procPtr->firstLocalPtr;
+	    for (i = 0; i < new->numArgs; i++, localPtr = localPtr->nextPtr) {
+		CompiledLocal *copy = (CompiledLocal *) ckalloc((unsigned)
+			(sizeof(CompiledLocal) -sizeof(localPtr->name)
+			+ localPtr->nameLength + 1));
+		if (new->firstLocalPtr == NULL) {
+		    new->firstLocalPtr = new->lastLocalPtr = copy;
+		} else {
+		    new->lastLocalPtr->nextPtr = copy;
+		    new->lastLocalPtr = copy;
+		}
+		copy->nextPtr = NULL;
+		copy->nameLength = localPtr->nameLength;
+		copy->frameIndex = localPtr->frameIndex;
+		copy->flags = localPtr->flags;
+		copy->defValuePtr = localPtr->defValuePtr;
+		if (copy->defValuePtr) {
+		    Tcl_IncrRefCount(copy->defValuePtr);
+		}
+		copy->resolveInfo = localPtr->resolveInfo;
+		strcpy(copy->name, localPtr->name);
+	    }
+
+	    /* Reset the ClientData */
+	    Tcl_GetCommandInfoFromToken(token, &info);
+	    if (info.objClientData == (ClientData) procPtr) {
+		info.objClientData = (ClientData) new;
+	    }
+	    if (info.clientData == (ClientData) procPtr) {
+		info.clientData = (ClientData) new;
+	    }
+	    if (info.deleteData == (ClientData) procPtr) {
+		info.deleteData = (ClientData) new;
+	    }
+	    Tcl_SetCommandInfoFromToken(token, &info);
+
+	    procPtr->refCount--;
+	    *procPtrPtr = procPtr = new;
+	}
  	iPtr->compiledProcPtr = procPtr;
 
  	result = TclPushStackFrame(interp, &framePtr,