* tclProc.c (SetLambdaFromAny):

	* tests/apply.test (9.1-9.2): plugged intrep leak [Bug 1578454],
	found by mjanssen.

1 files changed, 40 insertions, 1 deletions

diff --git a/tests/apply.test b/tests/apply.test
index b1769fa..563210c 100644
--- a/tests/apply.test
+++ b/tests/apply.test
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: apply.test,v 1.6 2006/10/09 19:15:41 msofer Exp $
+# RCS: @(#) $Id: apply.test,v 1.7 2006/10/16 20:36:19 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -23,6 +23,8 @@ if {[info commands ::apply] eq {}} {
     return
 }
 
+testConstraint memory     [llength [info commands memory]]
+
 # Tests for wrong number of arguments
 
 test apply-1.1 {too few arguments} {
@@ -261,6 +263,43 @@ test apply-8.10 {default values} {
     apply [list {x {y 2} args} $applyBody] 1 3
 } {{x 1} {y 3} {args {}}}
 
+# Tests for leaks
+
+test apply-9.1 {leaking internal rep} -setup {
+    proc getbytes {} {
+	set lines [split [memory info] "\n"]
+	lindex $lines 3 3
+    }
+    set lam [list {} {set a 1}]
+} -constraints memory -body {
+    set end [getbytes]
+    for {set i 0} {$i < 5} {incr i} {
+	::apply [lrange $lam 0 end]
+	set tmp $end
+	set end [getbytes]
+    }
+    set leakedBytes [expr {$end - $tmp}]
+} -cleanup {
+    rename getbytes {}
+    unset lam
+} -result 0
+test apply-9.2 {leaking internal rep} -setup {
+    proc getbytes {} {
+	set lines [split [memory info] "\n"]
+	lindex $lines 3 3
+    }
+} -constraints memory -body {
+    set end [getbytes]
+    for {set i 0} {$i < 5} {incr i} {
+	::apply [list {} {set a 1}]
+	set tmp $end
+	set end [getbytes]
+    }
+    set leakedBytes [expr {$end - $tmp}]
+} -cleanup {
+    rename getbytes {}
+} -result 0
+
 # Tests for the avoidance of recompilation
 
 # cleanup