summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorapnadkarni <apnmbx-wits@yahoo.com>2023-07-12 02:31:54 (GMT)
committerapnadkarni <apnmbx-wits@yahoo.com>2023-07-12 02:31:54 (GMT)
commit4ee94e4f670279c82c6af59820e2d7d82c774ca5 (patch)
treec3b8601ade8af228590b461014cf0031d1e6f015
parent04328bc72033c31bd77ac75f27def3e39bd4d117 (diff)
downloadtcl-4ee94e4f670279c82c6af59820e2d7d82c774ca5.zip
tcl-4ee94e4f670279c82c6af59820e2d7d82c774ca5.tar.gz
tcl-4ee94e4f670279c82c6af59820e2d7d82c774ca5.tar.bz2
Add test
-rw-r--r--tests/lseq.test21
1 files changed, 21 insertions, 0 deletions
diff --git a/tests/lseq.test b/tests/lseq.test
index 6ec9bb2..a149908 100644
--- a/tests/lseq.test
+++ b/tests/lseq.test
@@ -21,6 +21,16 @@ testConstraint knownBug 0
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
@@ -707,6 +717,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