summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2016-07-14 14:40:37 (GMT)
committerdgp <dgp@users.sourceforge.net>2016-07-14 14:40:37 (GMT)
commit18d118050e87e9f2665c7da4358836e37dbd7a0f (patch)
treef24505853f7a4484d6a283ad58466d09c9e4d7eb
parentb91a1c74a96cb667373be1fa8b3da13dc82d071d (diff)
downloadtcl-18d118050e87e9f2665c7da4358836e37dbd7a0f.zip
tcl-18d118050e87e9f2665c7da4358836e37dbd7a0f.tar.gz
tcl-18d118050e87e9f2665c7da4358836e37dbd7a0f.tar.bz2
New test demonstrates memleak discovered by Rolf Ade.
-rw-r--r--tests/var.test30
1 files changed, 22 insertions, 8 deletions
diff --git a/tests/var.test b/tests/var.test
index e223f6e..803bbda 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -26,6 +26,21 @@ 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}
@@ -912,9 +927,6 @@ test var-21.0 {PushVarNameWord OBOE in compiled unset} -setup {
} -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) {}
@@ -934,13 +946,9 @@ test var-22.0 {leak in array element unset: Bug a3309d01db} -setup {
set leakedBytes [expr {$end - $tmp}]
} -cleanup {
array unset A
- rename getbytes {}
rename doit {}
} -result 0
test var-22.1 {leak in localVarName intrep: Bug 80304238ac} -setup {
- proc getbytes {} {
- lindex [split [memory info] \n] 3 3
- }
proc doit {} {
interp create slave
slave eval {
@@ -962,15 +970,21 @@ test var-22.1 {leak in localVarName intrep: Bug 80304238ac} -setup {
set leakedBytes [expr {$end - $tmp}]
} -cleanup {
array unset A
- rename getbytes {}
rename doit {}
} -result 0
+test var-22.2 {leak in parsedVarName} -constraints memory -body {
+ set i 0
+ leaktest {lappend x($i)}
+} -cleanup {
+ unset -nocomplain i x
+} -result 0
catch {namespace delete ns}
catch {unset arr}
catch {unset v}
+catch {rename getbytes ""}
catch {rename p ""}
catch {namespace delete test_ns_var}
catch {namespace delete test_ns_var2}