diff options
-rw-r--r-- | ChangeLog | 18 | ||||
-rw-r--r-- | generic/tclVar.c | 17 | ||||
-rw-r--r-- | tests/var.test | 15 |
3 files changed, 48 insertions, 2 deletions
@@ -1,3 +1,21 @@ +2000-01-14 Eric Melski <ericm@scriptics.com> + + * tests/var.test: Added a test for the array multiple delete + protection in Tcl_UnsetVar2. + + * generic/tclVar.c: Added protection in Tcl_UnsetVar2 against + attempts to multiply delete arrays when unsetting them (bug + #3453). This could happen if there was an unset trace on an array + element and the trace proc made a global or upvar link to the + array, and then the array was unset at the global level. See the + bug reference for more information. + + * unix/tclUnixTime.c: New clock format format. + + * compat/strftime.c: New clock format format. + + * generic/tclGetDate.y: New clock scan format. + 2000-01-13 Jeff Hobbs <hobbs@scriptics.com> * changes: updated changes file to reflect 8.3b2 mods diff --git a/generic/tclVar.c b/generic/tclVar.c index 252da01..277247e 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -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: tclVar.c,v 1.14 1999/10/05 22:45:40 hobbs Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.15 2000/01/15 02:52:32 ericm Exp $ */ #include "tclInt.h" @@ -2175,8 +2175,23 @@ Tcl_UnsetVar2(interp, part1, part2, flags) dummyVarPtr = &dummyVar; if (TclIsVarArray(dummyVarPtr) && !TclIsVarUndefined(dummyVarPtr)) { + /* + * Deleting the elements of the array may cause traces to be fired + * on those elements. Before deleting them, bump the reference count + * of the array, so that if those trace procs make a global or upvar + * link to the array, the array is not deleted when the call stack + * gets popped (we will delete the array ourselves later in this + * function). + * + * Bumping the count can lead to the odd situation that elements of the + * array are being deleted when the array still exists, but since the + * array is about to be removed anyway, that shouldn't really matter. + */ + varPtr->refCount++; DeleteArray(iPtr, part1, dummyVarPtr, (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS); + /* Decr ref count */ + varPtr->refCount--; } if (TclIsVarScalar(dummyVarPtr) && (dummyVarPtr->value.objPtr != NULL)) { diff --git a/tests/var.test b/tests/var.test index b18e0ae..e72014c 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.10 1999/12/12 02:27:04 hobbs Exp $ +# RCS: @(#) $Id: var.test,v 1.11 2000/01/15 02:52:32 ericm Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -617,6 +617,19 @@ test var-12.1 {TclFindCompiledLocals, {} array name} { } } {0 1 2 2,foo} +test var-13.1 {Tcl_UnsetVar2, unset array with trace set on element} { + proc foo {var ind op} { + global t + set foo bar + } + namespace eval :: { + set t(1) 1 + trace variable t(1) u foo + unset t + } + set x "If you see this, it worked" +} "If you see this, it worked" + catch {namespace delete ns} catch {unset arr} catch {unset v} |