summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2016-09-07 17:30:18 (GMT)
committerdgp <dgp@users.sourceforge.net>2016-09-07 17:30:18 (GMT)
commitf4881ad277e61ae34673ee464a4d43ac5da32ab3 (patch)
tree4a866ebaa14a3878cab0cd22e0c654882add6131
parent05c0da6eee9a84deb417980eb524efd8395516ec (diff)
parenta05766d3d315e7ecba48b10b3d24d98a7cd450df (diff)
downloadtcl-f4881ad277e61ae34673ee464a4d43ac5da32ab3.zip
tcl-f4881ad277e61ae34673ee464a4d43ac5da32ab3.tar.gz
tcl-f4881ad277e61ae34673ee464a4d43ac5da32ab3.tar.bz2
[4dbdd9af14] Plug mem leak when var unset trace re-creates namespace var.
Thanks mr_calvin for report and fix.
-rw-r--r--generic/tclVar.c20
-rw-r--r--tests/var.test31
2 files changed, 48 insertions, 3 deletions
diff --git a/generic/tclVar.c b/generic/tclVar.c
index bdc64b7..e95307e 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -4498,11 +4498,14 @@ TclDeleteNamespaceVars(
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
- * 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 +4530,17 @@ 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);
+ }
+ Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
VarHashRefCount(varPtr)--;
VarHashDeleteEntry(varPtr);
}
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 \