diff options
Diffstat (limited to 'tests/cmdIL.test')
| -rw-r--r-- | tests/cmdIL.test | 32 |
1 files changed, 28 insertions, 4 deletions
diff --git a/tests/cmdIL.test b/tests/cmdIL.test index 316a945..c8f5e0e 100644 --- a/tests/cmdIL.test +++ b/tests/cmdIL.test @@ -19,6 +19,18 @@ catch [list package require -exact tcl::test [info patchlevel]] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] +proc memusage {} { + set fd [open /proc/[pid]/statm] + set line [gets $fd] + if {[llength $line] != 7} { + error "Unexpected /proc/pid/statm format" + } + set result [lindex $line 5] + close $fd + return $result +} +testConstraint hasMemUsage [expr {![catch {memusage}]}] + testConstraint testobj [llength [info commands testobj]] source [file join [file dirname [info script]] internals.tcl] namespace import -force ::tcltest::internals::* @@ -137,7 +149,7 @@ test cmdIL-1.32 {lsort -stride errors} -returnCodes error -body { } -result {expected integer but got "foo"} test cmdIL-1.33 {lsort -stride errors} -returnCodes error -body { lsort -stride 1 bar -} -match glob -result {stride length must be between 2 and *} +} -result {stride length must be at least 2} test cmdIL-1.34 {lsort -stride errors} -returnCodes error -body { lsort -stride 2 {a b c} } -result {list size must be a multiple of the stride length} @@ -170,7 +182,7 @@ test cmdIL-1.42 {lsort -stride and-index} -body { } -returnCodes error -result {index "-1-1" out of range} test cmdIL-1.43 {lsort -stride errors} -returnCodes error -body { lsort -stride 4294967296 bar -} -match glob -result {stride length must be between 2 and *} +} -result {list size must be a multiple of the stride length} # Can't think of any good tests for the MergeSort and MergeLists procedures, # except a bunch of random lists to sort. @@ -743,19 +755,31 @@ test cmdIL-6.24 {lassign command - memory leak testing} -setup { rename stress {} } # Assorted shimmering problems -test cmdIL-6.25 {lassign command - shimmering protection} -body { +test cmdIL-6.25 {lassign command (compiled) - shimmering protection} -body { apply {{} { set x {a b c} list [lassign $x $x y] $x [set $x] $y }} } -result {c {a b c} a b} -test cmdIL-6.26 {lassign command - shimmering protection} -body { +test cmdIL-6.26 {lassign command (uncompiled) - shimmering protection} -body { apply {{} { set x {a b c} set lassign lassign list [$lassign $x $x y] $x [set $x] $y }} } -result {c {a b c} a b} +test cmdIL-6.27 {bug-f5e36eb588 - uncompiled lassign on lseq does not bloat memory} -constraints { + hasMemUsage +} -body { + set l [lseq 1000000] + lassign $l x + set premem [memusage] + set lassign lassign + $lassign $l x + set postmem [memusage] + expr {($postmem-$premem) < 100} +} -result 1 + test cmdIL-7.1 {lreverse command} -body { lreverse |