summaryrefslogtreecommitdiffstats
path: root/tests/apply.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/apply.test')
-rw-r--r--tests/apply.test41
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