diff options
| -rw-r--r-- | generic/tclExecute.c | 32 | ||||
| -rw-r--r-- | tests/lseq.test | 21 |
2 files changed, 47 insertions, 6 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c index d739033..674406c 100644 --- a/generic/tclExecute.c +++ b/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]; diff --git a/tests/lseq.test b/tests/lseq.test index 77dd422..4c1f14b 100644 --- a/tests/lseq.test +++ b/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 |