From ac5377745066c2cc9fdc1d30ff2d449e2bb5b6d4 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Sun, 10 Jun 2012 23:34:45 +0000
Subject: 3532959 Arrange for every lambda to place an entry in the
 linePBodyPtr hash table. Then the two teardowns of data in that table
 synchronize so that the first to run signals the other not to operate.  Test
 proc-7.4 in a mem debug build of Tcl will detect Bug 3532959 by crashing.

---
 generic/tclBasic.c | 10 ++++++----
 generic/tclProc.c  | 22 +++++++++++++---------
 tests/proc.test    |  8 ++++++++
 3 files changed, 27 insertions(+), 13 deletions(-)

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 1d289f2..fa13b50 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -1390,11 +1390,13 @@ DeleteInterpProc(
 	    CmdFrame *cfPtr = Tcl_GetHashValue(hPtr);
 	    Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr);
 	    procPtr->iPtr = NULL;
-	    if (cfPtr->type == TCL_LOCATION_SOURCE) {
-		Tcl_DecrRefCount(cfPtr->data.eval.path);
+	    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 325506b..7a93dbf 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 == NULL || iPtr->linePBodyPtr == NULL) {
+    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,7 @@ SetLambdaFromAny(
     Interp *iPtr = (Interp *) interp;
     char *name;
     Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv, *errPtr;
-    int objc, result;
+    int isNew, objc, result;
     Proc *procPtr;
 
     if (interp == NULL) {
@@ -2512,6 +2514,8 @@ SetLambdaFromAny(
      * common elements into a single function.
      */
 
+    Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, (char *) procPtr,
+	    &isNew), NULL);
     if (iPtr->cmdFramePtr) {
 	CmdFrame *contextPtr;
 
@@ -2544,7 +2548,7 @@ SetLambdaFromAny(
 
 	    if (contextPtr->line
 		    && (contextPtr->nline >= 2) && (contextPtr->line[1] >= 0)) {
-		int isNew, buf[2];
+		int buf[2];
 		CmdFrame *cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame));
 
 		/*
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
-- 
cgit v0.12