summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2016-09-08 02:38:39 (GMT)
committerdgp <dgp@users.sourceforge.net>2016-09-08 02:38:39 (GMT)
commitc088b6c59a66d5a20ea5ebff150030eb453fa0a9 (patch)
tree6f028a1e0968934dbf7af5667f2f244df5e4175c
parent48203a2fef2dfbef11cc1ba5d5aaf778f9603a67 (diff)
parent69e6c8e2f7cc9c7cd816bb7acfe52c7b4556e4cb (diff)
downloadtcl-c088b6c59a66d5a20ea5ebff150030eb453fa0a9.zip
tcl-c088b6c59a66d5a20ea5ebff150030eb453fa0a9.tar.gz
tcl-c088b6c59a66d5a20ea5ebff150030eb453fa0a9.tar.bz2
[7f02ff1efa] Fix scope for var unset traces when procs return.
*** POTENTIAL INCOMPATIBILITY ***
-rw-r--r--generic/tclNamesp.c20
-rw-r--r--generic/tclVar.c49
-rw-r--r--tests/trace.test23
3 files changed, 62 insertions, 30 deletions
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 7f6ecf5..74dfaf8 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -382,19 +382,6 @@ 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);
@@ -422,6 +409,13 @@ 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 48e09f6..0b371ee 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -5032,27 +5032,44 @@ 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);
-
- /*
- * Determine what flags to pass to the trace callback functions.
- */
-
- flags = TCL_TRACE_UNSETS;
- if (tablePtr == &iPtr->globalNsPtr->varTable) {
- flags |= TCL_GLOBAL_ONLY;
- } else if (tablePtr == &currNsPtr->varTable) {
- flags |= TCL_NAMESPACE_ONLY;
- }
for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
varPtr = VarHashFirstVar(tablePtr, &search)) {
- UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags,
- -1);
+ 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;
+ }
+ }
+ }
+
+ if (!TclIsVarUndefined(varPtr)) {
+ UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr),
+ NULL, TCL_TRACE_UNSETS, -1);
+ }
+
+ VarHashRefCount(varPtr)--;
VarHashDeleteEntry(varPtr);
}
VarHashDeleteTable(tablePtr);
diff --git a/tests/trace.test b/tests/trace.test
index 1099f48..3b69d38 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 1 {info vars}]}}}
+ proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel 2 {info vars}]}}}
set info {}
p1 foo bar
set info
@@ -1263,6 +1263,27 @@ 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.