diff options
Diffstat (limited to 'tests/frame.test')
| -rw-r--r-- | tests/frame.test | 53 |
1 files changed, 9 insertions, 44 deletions
diff --git a/tests/frame.test b/tests/frame.test index 9cb5070..bb68dba 100644 --- a/tests/frame.test +++ b/tests/frame.test @@ -12,46 +12,8 @@ namespace import ::tcltest::* tcltest::configure {*}$argv tcltest::loadTestedCommands -tcltest::testConstraint x11 [expr {[tk windowingsystem] eq "x11"}] - -# eatColors -- -# Creates a toplevel window and allocates enough colors in it to use up all -# the slots in an 8-bit colormap. -# -# Arguments: -# w - Name of toplevel window to create. - -proc eatColors {w} { - catch {destroy $w} - toplevel $w - wm geom $w +0+0 - canvas $w.c -width 400 -height 200 -bd 0 - pack $w.c - for {set y 0} {$y < 8} {incr y} { - for {set x 0} {$x < 40} {incr x} { - set color [format #%02x%02x%02x [expr {$x*6}] [expr {$y*30}] 0] - $w.c create rectangle [expr {10*$x}] [expr {20*$y}] \ - [expr {10*$x + 10}] [expr {20*$y + 20}] -outline {} \ - -fill $color - } - } - update -} - -# colorsFree -- -# -# Returns 1 if there appear to be free colormap entries in a window, 0 -# otherwise. -# -# Arguments: -# w - Name of window in which to check. -# red, green, blue - Intensities to use in a trial color allocation -# to see if there are colormap entries free. - -proc colorsFree {w {red 31} {green 245} {blue 192}} { - lassign [winfo rgb $w [format "#%02x%02x%02x" $red $green $blue]] r g b - expr {($r/256 == $red) && ($g/256 == $green) && ($b/256 == $blue)} -} +# Import utility procs for specific functional areas +testutils import colors # uniq -- # @@ -1767,13 +1729,16 @@ test frame-15.14 {TIP 262: toplevel background images} -setup { deleteWindows catch {image delete gorp} } -result {{gorp get} {gorp display 0 0 30 15} {gorp display 0 0 30 10} {gorp display 0 0 20 15} {gorp display 0 0 20 10}} - -# cleanup + +# +# CLEANUP +# + deleteWindows apply {cmds {foreach cmd $cmds {rename $cmd {}}}} { - eatColors colorsFree uniq optnames + uniq optnames } - +testutils forget colors cleanupTests return |