3532959 Make sure the lifetime management of entries in the linePBodyPtr hash

table can tolerate either order of teardown, interp first, or Proc first.

4 files changed, 38 insertions, 18 deletions

diff --git a/ChangeLog b/ChangeLog
index 41699a1..04407b7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2012-06-11  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclBasic.c:	[Bug 3532959] Make sure the lifetime management
+	* generic/tclProc.c:	of entries in the linePBodyPtr hash table can
+	* tests/proc.test:	tolerate either order of teardown, interp first,
+	or Proc first.
+
 2012-06-08  Don Porter  <dgp@users.sourceforge.net>
 
 	* unix/configure.in:	Update autogoo for gettimeofday().
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 954b2b3..fa13b50 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -1388,12 +1388,15 @@ DeleteInterpProc(
 		hPtr != NULL;
 		hPtr = Tcl_NextHashEntry(&hSearch)) {
 	    CmdFrame *cfPtr = Tcl_GetHashValue(hPtr);
-
-	    if (cfPtr->type == TCL_LOCATION_SOURCE) {
-		Tcl_DecrRefCount(cfPtr->data.eval.path);
+	    Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr);
+	    procPtr->iPtr = NULL;
+	    if (cfPtr) {
+		if (cfPtr->type == TCL_LOCATION_SOURCE) {
+		    Tcl_DecrRefCount(cfPtr->data.eval.path);
+		}
+		ckfree((char *) cfPtr->line);
+		ckfree((char *) cfPtr);
 	    }
-	    ckfree((char *) cfPtr->line);
-	    ckfree((char *) cfPtr);
 	    Tcl_DeleteHashEntry(hPtr);
 	}
 	Tcl_DeleteHashTable(iPtr->linePBodyPtr);
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 43e88c6..2c6d300 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -2198,7 +2198,7 @@ TclProcCleanupProc(
      * the same ProcPtr is overwritten with a new CmdFrame.
      */
 
-    if (!iPtr) {
+    if (iPtr == NULL) {
 	return;
     }
 
@@ -2209,13 +2209,15 @@ TclProcCleanupProc(
 
     cfPtr = (CmdFrame *) Tcl_GetHashValue(hePtr);
 
-    if (cfPtr->type == TCL_LOCATION_SOURCE) {
-	Tcl_DecrRefCount(cfPtr->data.eval.path);
-	cfPtr->data.eval.path = NULL;
+    if (cfPtr) {
+	if (cfPtr->type == TCL_LOCATION_SOURCE) {
+	    Tcl_DecrRefCount(cfPtr->data.eval.path);
+	    cfPtr->data.eval.path = NULL;
+	}
+	ckfree((char *) cfPtr->line);
+	cfPtr->line = NULL;
+	ckfree((char *) cfPtr);
     }
-    ckfree((char *) cfPtr->line);
-    cfPtr->line = NULL;
-    ckfree((char *) cfPtr);
     Tcl_DeleteHashEntry(hePtr);
 }
 
@@ -2447,7 +2449,8 @@ SetLambdaFromAny(
     Interp *iPtr = (Interp *) interp;
     char *name;
     Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv, *errPtr;
-    int objc, result;
+    int isNew, objc, result;
+    CmdFrame *cfPtr = NULL;
     Proc *procPtr;
 
     if (interp == NULL) {
@@ -2544,14 +2547,14 @@ SetLambdaFromAny(
 
 	    if (contextPtr->line
 		    && (contextPtr->nline >= 2) && (contextPtr->line[1] >= 0)) {
-		int isNew, buf[2];
-		CmdFrame *cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame));
+		int buf[2];
 
 		/*
 		 * Move from approximation (line of list cmd word) to actual
 		 * location (line of 2nd list element).
 		 */
 
+		cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame));
 		TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL);
 
 		cfPtr->level = -1;
@@ -2567,9 +2570,6 @@ SetLambdaFromAny(
 
 		cfPtr->cmd.str.cmd = NULL;
 		cfPtr->cmd.str.len = 0;
-
-		Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr,
-			(char *) procPtr, &isNew), cfPtr);
 	    }
 
 	    /*
@@ -2581,6 +2581,8 @@ SetLambdaFromAny(
 	}
 	TclStackFree(interp, contextPtr);
     }
+    Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, (char *) procPtr,
+	    &isNew), cfPtr);
 
     /*
      * Set the namespace for this lambda: given by objv[2] understood as a
diff --git a/tests/proc.test b/tests/proc.test
index 5673caa..c0f80e3 100644
--- a/tests/proc.test
+++ b/tests/proc.test
@@ -391,6 +391,14 @@ test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} {
     set res
 } {0 4}
 
+test proc-7.4 {Proc struct outlives its interp: Bug 3532959} {
+    set lambda x
+    lappend lambda {set a 1}
+    interp create slave
+    slave eval [list apply $lambda foo]
+    interp delete slave
+    unset lambda
+} {}
 
 
 # cleanup