From a05766d3d315e7ecba48b10b3d24d98a7cd450df Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 7 Sep 2016 16:19:42 +0000
Subject: Improve the comments and add a test.

---
 generic/tclVar.c | 13 +++++++++++--
 tests/var.test   | 31 +++++++++++++++++++++++++++++++
 2 files changed, 42 insertions(+), 2 deletions(-)

diff --git a/generic/tclVar.c b/generic/tclVar.c
index 55eb91c..e95307e 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -4500,8 +4500,12 @@ TclDeleteNamespaceVars(
 		NULL, flags);
 
 	/*
-	 * Remove the variable from the table and force it undefined in case
-	 * an unset trace brought it back from the dead.
+	 * We just unset the variable. However, an unset trace might
+	 * have re-set it, or might have re-established traces on it.
+	 * This namespace and its vartable are going away unconditionally,
+	 * so we cannot let such things linger. That would be a leak.
+	 *
+	 * First we destroy all traces. ...
 	 */
 
 	if (TclIsVarTraced(varPtr)) {
@@ -4527,6 +4531,11 @@ TclDeleteNamespaceVars(
 	    }
 	}
 
+	/*
+	 * ...and then, if the variable still holds a value, we unset it
+	 * again. This time with no traces left, we're sure it goes away.
+	 */
+
 	if (!TclIsVarUndefined(varPtr)) {
 	    UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr,
 		    NULL, flags);
diff --git a/tests/var.test b/tests/var.test
index c852ca9..30e340e 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -22,6 +22,21 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 testConstraint testupvar [llength [info commands testupvar]]
 testConstraint testgetvarfullname [llength [info commands testgetvarfullname]]
 testConstraint testsetnoerr [llength [info commands testsetnoerr]]
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+    proc getbytes {} {
+        return [lindex [split [memory info] \n] 3 3]
+    }
+    proc leaktest {script {iterations 3}} {
+        set end [getbytes]
+        for {set i 0} {$i < $iterations} {incr i} {
+            uplevel 1 $script
+            set tmp $end
+            set end [getbytes]
+        }
+        return [expr {$end - $tmp}]
+    }
+}
 
 catch {rename p ""}
 catch {namespace delete test_ns_var}
@@ -540,6 +555,22 @@ test var-8.2 {TclDeleteNamespaceVars, "unset" traces on ns delete are called wit
     list [namespace delete test_ns_var] $::info
 } {{} {::test_ns_var::v {} u}}
 
+test var-8.3 {TclDeleteNamespaceVars, mem leak} -constraints memory -setup {
+    proc ::t {a i o} {
+	set $a 321
+    }
+} -body {
+    leaktest {
+	namespace eval n {
+	    variable v 123
+	    trace variable v u ::t
+	}
+	namespace delete n
+    }
+} -cleanup {
+    rename ::t {}
+} -result 0
+
 test var-9.1 {behaviour of TclGet/SetVar simple get/set} testsetnoerr {
     catch {unset u}; catch {unset v}
     list \
-- 
cgit v0.12