Fix [54329e39c7]

Author: apnadkarni

generic/tclExecute.c

@@ -6789,8 +6789,8 @@ TEBCresume(
 		goto gotError;
 	    }
 	    if (Tcl_IsShared(listPtr)) {
-		objPtr = TclDuplicatePureObj(
-		    interp, listPtr, &tclListType);
+		/* Do NOT use TclDuplicatePureObj here - shimmers abstract list to list */
+		objPtr = Tcl_DuplicateObj(listPtr);
 		if (!objPtr) {
 		    goto gotError;
 		}
@@ -6867,21 +6867,41 @@ TEBCresume(
 	    for (i = 0;  i < numLists;  i++) {
 		varListPtr = infoPtr->varLists[i];
 		numVars = varListPtr->numVars;
+		int hasAbstractList;
 
 		listPtr = OBJ_AT_DEPTH(listTmpDepth);
-		status = TclListObjGetElementsM(
-		    interp, listPtr, &listLen, &elements);
+		hasAbstractList =
+		    TclHasInternalRep(listPtr, &tclArithSeriesType);
+		DECACHE_STACK_INFO();
+		if (hasAbstractList) {
+		    status = Tcl_ListObjLength(interp, listPtr, &listLen);
+		    elements = NULL;
+		} else {
+		    status = TclListObjGetElementsM(
+			interp, listPtr, &listLen, &elements);
+		}
 		if (status != TCL_OK) {
+		    CACHE_STACK_INFO();
 		    goto gotError;
 		}
-
+		CACHE_STACK_INFO();
 
 		valIndex = (iterNum * numVars);
 		for (j = 0;  j < numVars;  j++) {
 		    if (valIndex >= listLen) {
 			TclNewObj(valuePtr);
 		    } else {
-			valuePtr = elements[valIndex];
+			if (elements) {
+			    valuePtr = elements[valIndex];
+			} else {
+			    DECACHE_STACK_INFO();
+			    valuePtr = TclArithSeriesObjIndex(
+				NULL, listPtr, valIndex);
+			    if (valuePtr == NULL) {
+				TclNewObj(valuePtr);
+			    }
+			    CACHE_STACK_INFO();
+			}
 		    }
 
 		    varIndex = varListPtr->varIndexes[j];

tests/lseq.test

@@ -20,6 +20,16 @@ testConstraint arithSeriesShimmerOk 1
 #testConstraint has64BitLengths [expr {$tcl_platform(pointerSize) == 8}]
 #testConstraint has32BitLengths [expr {$tcl_platform(pointerSize) == 4}]
 
+proc memusage {} {
+    set fd [open /proc/[pid]/statm]
+    set line [gets $fd]
+    if {[llength $line] != 7} {
+        error "Unexpected /proc/pid/statm format"
+    }
+    return [lindex $line 5]
+}
+testConstraint hasMemUsage [expr {![catch {memusage}]}]
+
 # Arg errors
 test lseq-1.1 {error cases} -body {
     lseq
@@ -671,6 +681,17 @@ test lseq-convertToList {does not result in a memory error} -body {
 	list [catch {set var1 [lindex [lreplace [lseq 1 2] 1 1 hello] 0]} cres] $cres
 } -cleanup {unset var1 cres} -result {1 {can't set "var1": this is an error}}
 
+test lseq-bug-54329e39c7 {does not cause memory bloat} -constraints {
+    hasMemUsage
+} -body {
+    set l [lseq 1000000]
+    proc p l {foreach x $l {}}
+    set premem [memusage]
+    p $l
+    set postmem [memusage]
+    expr {($postmem - $premem) < 10}
+} -result 1
+
 # cleanup
 ::tcltest::cleanupTests