diff options
author | dgp <dgp@users.sourceforge.net> | 2016-09-07 17:45:33 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2016-09-07 17:45:33 (GMT) |
commit | b2285feb18ebbcf95efeec554d49294c0d6c499a (patch) | |
tree | 7707f92ef5581b074d89e0165ccf17f1d43cb680 /tests | |
parent | ea21bb5de3ca09b64d101656f0613cd10f877aa6 (diff) | |
parent | f4881ad277e61ae34673ee464a4d43ac5da32ab3 (diff) | |
download | tcl-b2285feb18ebbcf95efeec554d49294c0d6c499a.zip tcl-b2285feb18ebbcf95efeec554d49294c0d6c499a.tar.gz tcl-b2285feb18ebbcf95efeec554d49294c0d6c499a.tar.bz2 |
[4dbdd9af14] Plug mem leak when var unset trace re-creates namespace var. Thanks mr_calvin for report and fix.
Diffstat (limited to 'tests')
-rw-r--r-- | tests/var.test | 30 |
1 files changed, 30 insertions, 0 deletions
diff --git a/tests/var.test b/tests/var.test index 297034a..a9d93ac 100644 --- a/tests/var.test +++ b/tests/var.test @@ -26,6 +26,20 @@ testConstraint testupvar [llength [info commands testupvar]] testConstraint testgetvarfullname [llength [info commands testgetvarfullname]] testConstraint testsetnoerr [llength [info commands testsetnoerr]] testConstraint memory [llength [info commands memory]] +if {[testConstraint memory]} { + proc getbytes {} { + return [lindex [split [memory info] \n] 3 3] + } + proc leaktest {script {iterations 3}} { + set end [getbytes] + for {set i 0} {$i < $iterations} {incr i} { + uplevel 1 $script + set tmp $end + set end [getbytes] + } + return [expr {$end - $tmp}] + } +} catch {rename p ""} catch {namespace delete test_ns_var} @@ -579,6 +593,22 @@ test var-8.2 {TclDeleteNamespaceVars, "unset" traces on ns delete are called wit list [namespace delete test_ns_var] $::info } -result {{} {::test_ns_var::v {} u}} +test var-8.3 {TclDeleteNamespaceVars, mem leak} -constraints memory -setup { + proc ::t {a i o} { + set $a 321 + } +} -body { + leaktest { + namespace eval n { + variable v 123 + trace variable v u ::t + } + namespace delete n + } +} -cleanup { + rename ::t {} +} -result 0 + test var-9.1 {behaviour of TclGet/SetVar simple get/set} -setup { catch {unset u} catch {unset v} |