Demonstrate and fix memory leak in Tcl_ParseVar().

1 files changed, 21 insertions, 0 deletions

diff --git a/tests/parse.test b/tests/parse.test
index b9cfe80..9f2d50b 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -27,6 +27,7 @@ testConstraint testparsevar [llength [info commands testparsevar]]
 testConstraint testasync [llength [info commands testasync]]
 testConstraint testcmdtrace [llength [info commands testcmdtrace]]
 testConstraint testevent [llength [info commands testevent]]
+testConstraint memory [llength [info commands memory]]
 
 test parse-1.1 {Tcl_ParseCommand procedure, computing string length} testparser {
     testparser [bytestring "foo\0 bar"] -1
@@ -678,6 +679,26 @@ test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} testparsevar
     unset -nocomplain abc
     list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg
 } {1 {invalid command name "bogus"}}
+test parse-13.6 {Tcl_ParseVar memory leak} -constraints memory -setup {
+    proc getbytes {} {
+	return [lindex [split [memory info] \n] 3 3]
+    }
+} -body {
+    set a() foo
+    set end [getbytes]
+    for {set i 0} {$i < 5} {incr i} {
+	set vn {}
+	set res [testparsevar [append vn $ a([string repeat {[]} 19]) bar]]
+	if {$res ne {foo bar}} {error "Unexpected result: $res"}
+
+	set tmp $end
+	set end [getbytes]
+    }
+    expr {$end - $tmp}
+} -cleanup {
+    unset -nocomplain a end i vn res tmp
+    rename getbytes {}
+} -result 0
 
 test parse-14.1 {Tcl_ParseBraces procedure, computing string length} testparser {
     testparser [bytestring "foo\0 bar"] -1