From 927fbda30f0ee4a5e2201dc1539f392e15a19412 Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Tue, 11 Mar 2008 17:23:55 +0000
Subject: 	* 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].

---
 ChangeLog        |  8 ++++++++
 generic/tclVar.c | 10 ++++++++--
 tests/var.test   | 18 +++++++++++++++++-
 3 files changed, 33 insertions(+), 3 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 49249bc..7355edb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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 \
-- 
cgit v0.12