diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/place.test | 46 |
1 files changed, 45 insertions, 1 deletions
diff --git a/tests/place.test b/tests/place.test index 847047c..c2a4042 100644 --- a/tests/place.test +++ b/tests/place.test @@ -5,12 +5,15 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: place.test,v 1.10 2003/04/01 21:06:49 dgp Exp $ +# RCS: @(#) $Id: place.test,v 1.11 2004/09/16 18:01:20 pspjuth Exp $ package require tcltest 2.1 eval tcltest::configure $argv tcltest::loadTestedCommands +# Used for constraining memory leak tests +testConstraint memory [llength [info commands memory]] + # XXX - This test file is woefully incomplete. At present, only a # few of the features are tested. @@ -380,6 +383,47 @@ test place-13.1 {test respect for internalborder} { set res } {196x188+2+10 177x186+5+7} +test place-14.1 {memory leak testing} -setup { + proc getbytes {} { + set lines [split [memory info] "\n"] + lindex [lindex $lines 3] 3 + } + # Repeat each body checking that memory does not increase + proc stress {args} { + set res {} + foreach body $args { + set end 0 + for {set i 0} {$i < 5} {incr i} { + uplevel 1 $body + set tmp $end + set end [getbytes] + } + lappend res [expr {$end - $tmp}] + } + return $res + } +} -constraints memory -body { + # Test all manners of forgetting a slave + frame .f + frame .f.f + stress { + place .f.f -x [expr {1 + 1}] -y [expr {2 + 2}] + place forget .f.f + } { + place .f.f -x [expr {1 + 1}] -y [expr {2 + 2}] + pack .f.f + } { + place .f.f -x [expr {1 + 1}] -y [expr {2 + 2}] + destroy .f + frame .f + frame .f.f + } +} -result {0 0 0} -cleanup { + destroy .f + rename getbytes {} + rename stress {} +} + catch {destroy .t} # cleanup |