From f26a4a0948cbd769519cf1e79ea027511051b2bd Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 9 Sep 2016 12:36:53 +0000
Subject: Revert b98ee56376. The "bug" fixed was documented behavior.

---
 generic/tclNamesp.c | 20 +++++++++++++-------
 generic/tclVar.c    | 49 ++++++++++++++++---------------------------------
 tests/trace.test    | 23 +----------------------
 3 files changed, 30 insertions(+), 62 deletions(-)

diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 74dfaf8..7f6ecf5 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -382,6 +382,19 @@ Tcl_PopCallFrame(
     register CallFrame *framePtr = iPtr->framePtr;
     Namespace *nsPtr;
 
+    /*
+     * It's important to remove the call frame from the interpreter's stack of
+     * call frames before deleting local variables, so that traces invoked by
+     * the variable deletion don't see the partially-deleted frame.
+     */
+
+    if (framePtr->callerPtr) {
+	iPtr->framePtr = framePtr->callerPtr;
+	iPtr->varFramePtr = framePtr->callerVarPtr;
+    } else {
+	/* Tcl_PopCallFrame: trying to pop rootCallFrame! */
+    }
+
     if (framePtr->varTablePtr != NULL) {
 	TclDeleteVars(iPtr, framePtr->varTablePtr);
 	ckfree(framePtr->varTablePtr);
@@ -409,13 +422,6 @@ Tcl_PopCallFrame(
     }
     framePtr->nsPtr = NULL;
 
-    if (framePtr->callerPtr) {
-	iPtr->framePtr = framePtr->callerPtr;
-	iPtr->varFramePtr = framePtr->callerVarPtr;
-    } else {
-	/* Tcl_PopCallFrame: trying to pop rootCallFrame! */
-    }
-
     if (framePtr->tailcallPtr) {
 	TclSetTailcall(interp, framePtr->tailcallPtr);
     }
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 0b371ee..48e09f6 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -5032,44 +5032,27 @@ TclDeleteVars(
     TclVarHashTable *tablePtr)	/* Hash table containing variables to
 				 * delete. */
 {
+    Tcl_Interp *interp = (Tcl_Interp *) iPtr;
     Tcl_HashSearch search;
     register Var *varPtr;
+    int flags;
+    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
 
-    for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
-	 varPtr = VarHashFirstVar(tablePtr, &search)) {
-	VarHashRefCount(varPtr)++;
-
-	UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr),
-		NULL, TCL_TRACE_UNSETS, -1);
-
-        if (TclIsVarTraced(varPtr)) {
-            Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr);
-            VarTrace *tracePtr = Tcl_GetHashValue(tPtr);
-            ActiveVarTrace *activePtr;
-
-            while (tracePtr) {
-                VarTrace *prevPtr = tracePtr;
-
-                tracePtr = tracePtr->nextPtr;
-                prevPtr->nextPtr = NULL;
-                Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC);
-            }
-            Tcl_DeleteHashEntry(tPtr);
-            varPtr->flags &= ~VAR_ALL_TRACES;
-            for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
-                    activePtr = activePtr->nextPtr) {
-                if (activePtr->varPtr == varPtr) {
-                    activePtr->nextTracePtr = NULL;
-                }
-            }
-        }
+    /*
+     * Determine what flags to pass to the trace callback functions.
+     */
 
-	if (!TclIsVarUndefined(varPtr)) {
-	    UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr),
-		    NULL, TCL_TRACE_UNSETS, -1);
-	}
+    flags = TCL_TRACE_UNSETS;
+    if (tablePtr == &iPtr->globalNsPtr->varTable) {
+	flags |= TCL_GLOBAL_ONLY;
+    } else if (tablePtr == &currNsPtr->varTable) {
+	flags |= TCL_NAMESPACE_ONLY;
+    }
 
-	VarHashRefCount(varPtr)--;
+    for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
+	 varPtr = VarHashFirstVar(tablePtr, &search)) {
+	UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags,
+		-1);
 	VarHashDeleteEntry(varPtr);
     }
     VarHashDeleteTable(tablePtr);
diff --git a/tests/trace.test b/tests/trace.test
index 3b69d38..1099f48 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -1227,7 +1227,7 @@ test trace-17.3 {traced variables must survive procedure exits} {
 
 test trace-18.1 {unset traces on procedure returns} {
     proc p1 {x y} {set a 44; p2 14}
-    proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel 2 {info vars}]}}}
+    proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel 1 {info vars}]}}}
     set info {}
     p1 foo bar
     set info
@@ -1263,27 +1263,6 @@ test trace-18.4 {namespace delete / trace vdelete combo, Bug \#1338280} {
     rename doTrace {}
     set info
 } 1110
-test trace-18.5 {Bug 7f02ff1efa} -setup {
-    proc constant {name value} {
-        upvar 1 $name c  
-        set c $value
-        trace variable c wu [list reset $value]
-    }
-    proc reset {v a i o} {
-        uplevel 1 [list constant $a $v]
-    }
-    proc demo {} {
-	constant pi 3.14
-    }
-} -body {
-    unset -nocomplain pi
-    demo
-    info exists pi
-} -cleanup {
-    rename demo {}
-    rename reset {}
-    rename constant {}
-} -result 0
 
 # Delete arrays when done, so they can be re-used as scalars
 # elsewhere.
-- 
cgit v0.12