diff options
author | dgp <dgp@users.sourceforge.net> | 2015-07-18 05:52:57 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2015-07-18 05:52:57 (GMT) |
commit | f42f4ba9e433ebb4b0234a6c5dbf445a82fe085a (patch) | |
tree | dc65fa808151cd31b022870da94c2725427d2a95 /tests/var.test | |
parent | b8f06cb252d82acd8bda326eed40ee05c656e874 (diff) | |
parent | e302e23957a3b891294747cc63f1d546ae2e61f8 (diff) | |
download | tcl-f42f4ba9e433ebb4b0234a6c5dbf445a82fe085a.zip tcl-f42f4ba9e433ebb4b0234a6c5dbf445a82fe085a.tar.gz tcl-f42f4ba9e433ebb4b0234a6c5dbf445a82fe085a.tar.bz2 |
[a3309d01db] Plug memleak in compiled [unset a($i)].
Diffstat (limited to 'tests/var.test')
-rw-r--r-- | tests/var.test | 28 |
1 files changed, 28 insertions, 0 deletions
diff --git a/tests/var.test b/tests/var.test index 7ff394e..0531746 100644 --- a/tests/var.test +++ b/tests/var.test @@ -25,6 +25,7 @@ catch [list package require -exact Tcltest [info patchlevel]] testConstraint testupvar [llength [info commands testupvar]] testConstraint testgetvarfullname [llength [info commands testgetvarfullname]] testConstraint testsetnoerr [llength [info commands testsetnoerr]] +testConstraint memory [llength [info commands memory]] catch {rename p ""} catch {namespace delete test_ns_var} @@ -894,6 +895,33 @@ test var-21.0 {PushVarNameWord OBOE in compiled unset} -setup { rename linenumber {} } -result 1 +test var-22.0 {leak in array element unset: Bug a3309d01db} -setup { + proc getbytes {} { + lindex [split [memory info] \n] 3 3 + } + proc doit k { + variable A + set A($k) {} + foreach n [array names A] { + if {$n <= $k-1} { + unset A($n) + } + } + } +} -constraints memory -body { + set end [getbytes] + for {set i 0} {$i < 5} {incr i} { + doit $i + 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} catch {unset arr} |