Merge core-9-0-branchcore-tip-716

1 files changed, 7 insertions, 44 deletions

diff --git a/tests/visual.test b/tests/visual.test
index c4e26d2..05bfcf7 100644
--- a/tests/visual.test
+++ b/tests/visual.test
@@ -12,47 +12,10 @@ namespace import ::tcltest::*
 tcltest::configure {*}$argv
 tcltest::loadTestedCommands
 
-update
-
-# eatColors --
-# Creates a toplevel window and allocates enough colors in it to
-# use up all the slots in the 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
-}
+# Import utility procs for specific functional areas
+testutils import colors
 
-# 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}} {
-    set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]]
-    expr {([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green)
-	&& ([lindex $vals 2]/256 == $blue)}
-}
+update
 
 # If more than one visual type is available for the screen, pick one
 # that is *not* the default.
@@ -556,12 +519,12 @@ test visual-8.2 {Tk_FreeColormap procedure} -constraints haveOtherVisual -setup
     deleteWindows
 } -result {}
 
+#
+# CLEANUP
+#
 
 deleteWindows
-rename eatColors {}
-rename colorsFree {}
-
-# cleanup
+testutils forget colors
 cleanupTests
 return