From eecf4343375af14eedadfc7dfc9d3b1b33491656 Mon Sep 17 00:00:00 2001
From: ericm <ericm>
Date: Sat, 15 Jan 2000 02:52:32 +0000
Subject: * 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.
---
 ChangeLog        | 18 ++++++++++++++++++
 generic/tclVar.c | 17 ++++++++++++++++-
 tests/var.test   | 15 ++++++++++++++-
 3 files changed, 48 insertions(+), 2 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 272c763..6dad3f6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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}
-- 
cgit v0.12