diff options
-rw-r--r-- | ChangeLog | 8 | ||||
-rw-r--r-- | generic/tclVar.c | 10 | ||||
-rw-r--r-- | tests/var.test | 18 |
3 files changed, 33 insertions, 3 deletions
@@ -1,3 +1,11 @@ +2008-03-11 Miguel Sofer <msofer@users.sf.net> + + * generic/tclVar.c (TclDeleteNamespaceVars): + * tests/var.test (var-8.2): unset traces on vars should be called + with a FQ named during namespace deletion. This was causing + infinite loops when unset traces recreated the var, as reported by + Julian Noble on [Bug 1911919]. + 2008-03-10 Don Porter <dgp@users.sourceforge.net> * changes: Updated for 8.5.2 release. diff --git a/generic/tclVar.c b/generic/tclVar.c index 1c7a7f7..3bcc527 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.159 2007/12/13 15:23:21 dgp Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.160 2008/03/11 17:23:56 msofer Exp $ */ #include "tclInt.h" @@ -4360,10 +4360,16 @@ TclDeleteNamespaceVars( for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL; varPtr = VarHashFirstVar(tablePtr, &search)) { + Tcl_Obj *objPtr = Tcl_NewObj(); + Tcl_IncrRefCount(objPtr); + VarHashRefCount(varPtr)++; /* Make sure we get to remove from * hash. */ - UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ VarHashGetKey(varPtr), + Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr); + UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr, NULL, flags); + Tcl_DecrRefCount(objPtr); /* free no longer needed obj */ + /* * Remove the variable from the table and force it undefined in case diff --git a/tests/var.test b/tests/var.test index c2420ff..bf48224 100644 --- a/tests/var.test +++ b/tests/var.test @@ -14,7 +14,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: var.test,v 1.30 2007/12/13 15:26:07 dgp Exp $ +# RCS: @(#) $Id: var.test,v 1.31 2008/03/11 17:23:56 msofer Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -527,6 +527,22 @@ test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var list [unset test_ns_var::v] $test_ns_var::info } {{} {test_ns_var::v {} u}} +test var-8.2 {TclDeleteNamespaceVars, "unset" traces on ns delete are called with fully-qualified var names} { + catch {namespace delete test_ns_var} + catch {unset a} + set info "" + namespace eval test_ns_var { + variable v 123 1 + trace var v u ::traceUnset + } + + proc traceUnset {name1 name2 op} { + set ::info [concat $::info [list $name1 $name2 $op]] + } + + list [namespace delete test_ns_var] $::info +} {{} {::test_ns_var::v {} u}} + test var-9.1 {behaviour of TclGet/SetVar simple get/set} testsetnoerr { catch {unset u}; catch {unset v} list \ |