[80304238ac] Prevent RC cycle in the localVarName objtype.

2 files changed, 36 insertions, 5 deletions

diff --git a/generic/tclVar.c b/generic/tclVar.c
index 451ef7b..5574f30 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -697,13 +697,16 @@ 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
+		    || cachedNamePtr->internalRep.twoPtrValue.ptr1 != NULL) {
+	        TclFreeIntRep(cachedNamePtr);
+	    }
 	} else {
 	    part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
 	}
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}