New test demonstrates memleak discovered by Rolf Ade.

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}