From 14bfb4aa231ac9f7eeebc59c28defedc4e30a002 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 26 Feb 2016 15:42:33 +0000
Subject: [80304238ac] Candidate fix for memleak due to RC cycle.
---
generic/tclVar.c | 12 +++++++-----
1 file changed, 7 insertions(+), 5 deletions(-)
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 451ef7b..12e52c2 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -697,13 +697,15 @@ TclObjLookupVarEx(
/*
* An indexed local variable.
*/
+ Tcl_Obj *cachedNamePtr = localName(iPtr->varFramePtr, index);
part1Ptr->typePtr = &localVarNameType;
- if (part1Ptr != localName(iPtr->varFramePtr, index)) {
- part1Ptr->internalRep.twoPtrValue.ptr1 =
- localName(iPtr->varFramePtr, index);
- Tcl_IncrRefCount((Tcl_Obj *)
- part1Ptr->internalRep.twoPtrValue.ptr1);
+ if (part1Ptr != cachedNamePtr) {
+ part1Ptr->internalRep.twoPtrValue.ptr1 = cachedNamePtr;
+ Tcl_IncrRefCount(cachedNamePtr);
+ if (cachedNamePtr->typePtr != &localVarNameType) {
+ TclFreeIntRep(cachedNamePtr);
+ }
} else {
part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
}
--
cgit v0.12
From 22557045ac8877ad5bc11249c371d01baf4907ba Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 1 Mar 2016 16:40:05 +0000
Subject: Add test for memleak
---
tests/var.test | 28 ++++++++++++++++++++++++++++
1 file changed, 28 insertions(+)
diff --git a/tests/var.test b/tests/var.test
index 0531746..b6b09fd 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -921,6 +921,34 @@ test var-22.0 {leak in array element unset: Bug a3309d01db} -setup {
rename getbytes {}
rename doit {}
} -result 0
+test var-22.1 {leak in localVarName intrep: Bug 80304238ac} -setup {
+ proc getbytes {} {
+ lindex [split [memory info] \n] 3 3
+ }
+ proc doit {} {
+ interp create slave
+ slave eval {
+ proc doit script {
+ eval $script
+ set foo bar
+ }
+ doit {foreach foo baz {}}
+ }
+ interp delete slave
+ }
+} -constraints memory -body {
+ set end [getbytes]
+ for {set i 0} {$i < 5} {incr i} {
+ doit
+ set tmp $end
+ set end [getbytes]
+ }
+ set leakedBytes [expr {$end - $tmp}]
+} -cleanup {
+ array unset A
+ rename getbytes {}
+ rename doit {}
+} -result 0
catch {namespace delete ns}
--
cgit v0.12
From 5be04ec11ef9378c093c4403bc37ee5e8955de2a Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 1 Mar 2016 16:42:03 +0000
Subject: Extra safety against cycles
---
generic/tclVar.c | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 12e52c2..5574f30 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -703,7 +703,8 @@ TclObjLookupVarEx(
if (part1Ptr != cachedNamePtr) {
part1Ptr->internalRep.twoPtrValue.ptr1 = cachedNamePtr;
Tcl_IncrRefCount(cachedNamePtr);
- if (cachedNamePtr->typePtr != &localVarNameType) {
+ if (cachedNamePtr->typePtr != &localVarNameType
+ || cachedNamePtr->internalRep.twoPtrValue.ptr1 != NULL) {
TclFreeIntRep(cachedNamePtr);
}
} else {
--
cgit v0.12