From 2fc3c8d6596a5d180b7f2c13451e8ec26144cb2b Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 17 Jul 2015 19:33:08 +0000 Subject: [a3309d01db] Test the demonstrates leak in branch off checkin that starts it. --- tests/var.test | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/tests/var.test b/tests/var.test index 208b361..26b4efa 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} @@ -878,6 +879,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} -- cgit v0.12