summaryrefslogtreecommitdiffstats
path: root/tests/visual.test
diff options
context:
space:
mode:
authoraniap <aniap>2008-08-30 21:52:26 (GMT)
committeraniap <aniap>2008-08-30 21:52:26 (GMT)
commitefda61bdd67b9f540aa57722efec0e2430e6056f (patch)
tree2b09e17e0659d453eeaf5dfc31c2a205148b5e91 /tests/visual.test
parent789cb9ff828c1e461866814e57d87a5c254b8c24 (diff)
downloadtk-efda61bdd67b9f540aa57722efec0e2430e6056f.zip
tk-efda61bdd67b9f540aa57722efec0e2430e6056f.tar.gz
tk-efda61bdd67b9f540aa57722efec0e2430e6056f.tar.bz2
Update to tcltest2
Diffstat (limited to 'tests/visual.test')
-rw-r--r--tests/visual.test564
1 files changed, 418 insertions, 146 deletions
diff --git a/tests/visual.test b/tests/visual.test
index b54a8e6..61f5001 100644
--- a/tests/visual.test
+++ b/tests/visual.test
@@ -7,10 +7,11 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: visual.test,v 1.10 2004/06/17 22:38:57 dkf Exp $
+# RCS: @(#) $Id: visual.test,v 1.11 2008/08/30 21:52:26 aniap Exp $
-package require tcltest 2.1
-eval tcltest::configure $argv
+package require tcltest 2.2
+namespace import ::tcltest::*
+tcltest::configure {*}$argv
tcltest::loadTestedCommands
update
@@ -20,7 +21,7 @@ update
# use up all the slots in the colormap.
#
# Arguments:
-# w - Name of toplevel window to create.
+# w - Name of toplevel window to create.
proc eatColors {w} {
catch {destroy $w}
@@ -29,12 +30,12 @@ proc eatColors {w} {
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
- }
+ 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
}
@@ -45,14 +46,14 @@ proc eatColors {w} {
# 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.
+# 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)
+ && ([lindex $vals 2]/256 == $blue)
}
# If more than one visual type is available for the screen, pick one
@@ -63,233 +64,500 @@ set avail [winfo visualsavailable .]
set other {}
if {[llength $avail] > 1} {
foreach visual $avail {
- if {$visual != $default} {
- set other $visual
- break
- }
+ if {$visual != $default} {
+ set other $visual
+ break
+ }
}
}
testConstraint haveOtherVisual [expr {$other ne ""}]
testConstraint havePseudocolorVisual [string match *pseudocolor* $avail]
testConstraint haveMultipleVisuals [expr {[llength $avail] > 1}]
-test visual-1.1 {Tk_GetVisual, copying from other window} {
- list [catch {toplevel .t -visual .foo.bar} msg] $msg
-} {1 {bad window path name ".foo.bar"}}
-test visual-1.2 {Tk_GetVisual, copying from other window} {haveOtherVisual nonPortable} {
- catch {destroy .t1}
- catch {destroy .t2}
+# ----------------------------------------------------------------------
+
+test visual-1.1 {Tk_GetVisual, copying from other window} -body {
+ toplevel .t -visual .foo.bar
+} -returnCodes error -result {bad window path name ".foo.bar"}
+test visual-1.2 {Tk_GetVisual, copying from other window} -constraints {
+ haveOtherVisual nonPortable
+} -setup {
+ deleteWindows
+} -body {
toplevel .t1 -width 250 -height 100 -visual $other
wm geom .t1 +0+0
toplevel .t2 -width 200 -height 80 -visual .t1
wm geom .t2 +5+5
concat "[winfo visual .t2] [winfo depth .t2]"
-} $other
-test visual-1.3 {Tk_GetVisual, copying from other window} haveOtherVisual {
- catch {destroy .t1}
- catch {destroy .t2}
+} -cleanup {
+ deleteWindows
+} -result $other
+test visual-1.3 {Tk_GetVisual, copying from other window} -constraints {
+ haveOtherVisual
+} -setup {
+ deleteWindows
+} -body {
toplevel .t1 -width 250 -height 100 -visual $other
wm geom .t1 +0+0
toplevel .t2 -width 200 -height 80 -visual .
wm geom .t2 +5+5
concat "[winfo visual .t2] [winfo depth .t2]"
-} $default
+} -cleanup {
+ deleteWindows
+} -result $default
# Make sure reference count is incremented when copying visual (the
# following test will cause the colormap to be freed prematurely if
# the reference count isn't incremented).
-test visual-1.4 {Tk_GetVisual, colormap reference count} haveOtherVisual {
- catch {destroy .t1}
- catch {destroy .t2}
+test visual-1.4 {Tk_GetVisual, colormap reference count} -constraints {
+ haveOtherVisual
+} -setup {
+ deleteWindows
+} -body {
toplevel .t1 -width 250 -height 100 -visual $other
wm geom .t1 +0+0
- set result [list [catch {toplevel .t2 -gorp 80 -visual .t1} msg] $msg]
+ set result [toplevel .t2 -gorp 80 -visual .t1]
update
- set result
-} {1 {unknown option "-gorp"}}
-test visual-1.5 {Tk_GetVisual, default colormap} {
- catch {destroy .t1}
+ return $result
+} -cleanup {
+ deleteWindows
+} -returnCodes error -result {unknown option "-gorp"}
+test visual-1.5 {Tk_GetVisual, default colormap} -setup {
+ deleteWindows
+} -body {
toplevel .t1 -width 250 -height 100 -visual default
wm geometry .t1 +0+0
update
concat "[winfo visual .t1] [winfo depth .t1]"
-} $default
+} -cleanup {
+ deleteWindows
+} -result $default
+
+
+test visual-2.1 {Tk_GetVisual, different visual types} -constraints {
+ nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual {truecolor 24}
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+} -cleanup {
+ deleteWindows
+} -result {truecolor 24}
+test visual-2.2 {Tk_GetVisual, different visual types} -constraints {
+ nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual {truecolor 24}
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+} -cleanup {
+ deleteWindows
+} -result {truecolor 24}
+test visual-2.3 {Tk_GetVisual, different visual types} -constraints {
+ nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual {truecolor 24}
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+} -cleanup {
+ deleteWindows
+} -result {truecolor 24}
+test visual-2.4 {Tk_GetVisual, different visual types} -constraints {
+ nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual {truecolor 24}
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+} -cleanup {
+ deleteWindows
+} -result {truecolor 24}
+test visual-2.5 {Tk_GetVisual, different visual types} -constraints {
+ nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual {truecolor 24}
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+} -cleanup {
+ deleteWindows
+} -result {truecolor 24}
+test visual-2.6 {Tk_GetVisual, different visual types} -constraints {
+ nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual {truecolor 24}
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+} -cleanup {
+ deleteWindows
+} -result {truecolor 24}
+test visual-2.7 {Tk_GetVisual, different visual types} -constraints {
+ nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual {truecolor 24}
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+} -cleanup {
+ deleteWindows
+} -result {truecolor 24}
+test visual-2.8 {Tk_GetVisual, different visual types} -constraints {
+ nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual {truecolor 24}
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+} -cleanup {
+ deleteWindows
+} -result {truecolor 24}
+test visual-2.9 {Tk_GetVisual, different visual types} -constraints {
+ nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual {directcolor 24}
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+} -cleanup {
+ deleteWindows
+} -result {directcolor 24}
+test visual-2.10 {Tk_GetVisual, different visual types} -constraints {
+ nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual {directcolor 24}
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+} -cleanup {
+ deleteWindows
+} -result {directcolor 24}
+test visual-2.11 {Tk_GetVisual, different visual types} -constraints {
+ nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual {directcolor 24}
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+} -cleanup {
+ deleteWindows
+} -result {directcolor 24}
+test visual-2.12 {Tk_GetVisual, different visual types} -constraints {
+ nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual {directcolor 24}
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+} -cleanup {
+ deleteWindows
+} -result {directcolor 24}
+test visual-2.13 {Tk_GetVisual, different visual types} -constraints {
+ nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual {directcolor 24}
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+} -cleanup {
+ deleteWindows
+} -result {directcolor 24}
+test visual-2.14 {Tk_GetVisual, different visual types} -constraints {
+ nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual {directcolor 24}
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+} -cleanup {
+ deleteWindows
+} -result {directcolor 24}
+test visual-2.15 {Tk_GetVisual, different visual types} -constraints {
+ nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual {directcolor 24}
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+} -cleanup {
+ deleteWindows
+} -result {directcolor 24}
+test visual-2.16 {Tk_GetVisual, different visual types} -constraints {
+ nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual {directcolor 24}
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+} -cleanup {
+ deleteWindows
+} -result {directcolor 24}
+test visual-2.17 {Tk_GetVisual, different visual types} -constraints {
+ nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual {truecolor 32}
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+} -cleanup {
+ deleteWindows
+} -result {truecolor 32}
-set i 1
-foreach visual $avail {
- test visual-2.$i {Tk_GetVisual, different visual types} {nonPortable} {
- catch {destroy .t1}
- toplevel .t1 -width 250 -height 100 -visual $visual
- wm geometry .t1 +0+0
- update
- concat "[winfo visual .t1] [winfo depth .t1]"
- } $visual
- incr i
-}
-test visual-3.1 {Tk_GetVisual, parsing visual string} {
- catch {destroy .t1}
+test visual-3.1 {Tk_GetVisual, parsing visual string} -setup {
+ deleteWindows
+} -body {
toplevel .t1 -width 250 -height 100 \
- -visual "[winfo visual .][winfo depth .]"
+ -visual "[winfo visual .][winfo depth .]"
wm geometry .t1 +0+0
update
concat "[winfo visual .t1] [winfo depth .t1]"
-} $default
-test visual-3.2 {Tk_GetVisual, parsing visual string} {
- catch {destroy .t1}
- list [catch {
- toplevel .t1 -width 250 -height 100 -visual goop20
- wm geometry .t1 +0+0
- } msg] $msg
-} {1 {unknown or ambiguous visual name "goop20": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}}
-test visual-3.3 {Tk_GetVisual, parsing visual string} {
- catch {destroy .t1}
- list [catch {
- toplevel .t1 -width 250 -height 100 -visual d
- wm geometry .t1 +0+0
- } msg] $msg
-} {1 {unknown or ambiguous visual name "d": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}}
-test visual-3.4 {Tk_GetVisual, parsing visual string} {
- catch {destroy .t1}
- list [catch {
- toplevel .t1 -width 250 -height 100 -visual static
- wm geometry .t1 +0+0
- } msg] $msg
-} {1 {unknown or ambiguous visual name "static": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}}
-test visual-3.5 {Tk_GetVisual, parsing visual string} {
- catch {destroy .t1}
- list [catch {
- toplevel .t1 -width 250 -height 100 -visual "pseudocolor 48x"
- wm geometry .t1 +0+0
- } msg] $msg
-} {1 {expected integer but got "48x"}}
+} -cleanup {
+ deleteWindows
+} -result $default
+test visual-3.2 {Tk_GetVisual, parsing visual string} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual goop20
+ wm geometry .t1 +0+0
+} -cleanup {
+ deleteWindows
+} -returnCodes error -result {unknown or ambiguous visual name "goop20": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}
+test visual-3.3 {Tk_GetVisual, parsing visual string} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual d
+ wm geometry .t1 +0+0
+} -cleanup {
+ deleteWindows
+} -returnCodes error -result {unknown or ambiguous visual name "d": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}
+test visual-3.4 {Tk_GetVisual, parsing visual string} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual static
+ wm geometry .t1 +0+0
+} -cleanup {
+ deleteWindows
+} -returnCodes error -result {unknown or ambiguous visual name "static": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}
+test visual-3.5 {Tk_GetVisual, parsing visual string} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual "pseudocolor 48x"
+ wm geometry .t1 +0+0
+} -cleanup {
+ deleteWindows
+} -returnCodes error -result {expected integer but got "48x"}
-test visual-4.1 {Tk_GetVisual, numerical visual id} -setup {
- catch {destroy .t1}
- catch {destroy .t2}
- catch {destroy .t3}
+
+test visual-4.1 {Tk_GetVisual, numerical visual id} -constraints {
+ haveOtherVisual nonPortable
+} -setup {
+ deleteWindows
toplevel .t1 -width 250 -height 100 -visual $other
wm geom .t1 +0+0
toplevel .t2 -width 200 -height 80 -visual [winfo visual .]
wm geom .t2 +5+5
toplevel .t3 -width 150 -height 250 -visual [winfo visual .t1]
wm geom .t3 +10+10
-} -constraints {haveOtherVisual nonPortable} -body {
+} -body {
set v1 [list [winfo visualid .t2] [winfo visualid .t3]]
set v2 [list [winfo visualid .] [winfo visualid .t1]]
expr {$v1 eq $v2 ? "OK" : "[list $v1] ne [list $v2]"}
-} -result OK -cleanup {
- destroy .t1 .t2 .t3
-}
-test visual-4.2 {Tk_GetVisual, numerical visual id} {
- catch {destroy .t1}
- list [catch {toplevel .t1 -visual 12xyz} msg] $msg
-} {1 {bad X identifier for visual: "12xyz"}}
-test visual-4.3 {Tk_GetVisual, numerical visual id} {
- catch {destroy .t1}
- list [catch {toplevel .t1 -visual 1291673} msg] $msg
-} {1 {couldn't find an appropriate visual}}
+} -cleanup {
+ deleteWindows
+} -result OK
+test visual-4.2 {Tk_GetVisual, numerical visual id} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -visual 12xyz
+} -cleanup {
+ deleteWindows
+} -returnCodes error -result {bad X identifier for visual: "12xyz"}
+test visual-4.3 {Tk_GetVisual, numerical visual id} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -visual 1291673
+} -cleanup {
+ deleteWindows
+} -returnCodes error -result {couldn't find an appropriate visual}
+
-test visual-5.1 {Tk_GetVisual, no matching visual} !havePseudocolorVisual {
- catch {destroy .t1}
- list [catch {
- toplevel .t1 -width 250 -height 100 -visual "pseudocolor 8"
- wm geometry .t1 +0+0
- } msg] $msg
-} {1 {couldn't find an appropriate visual}}
+test visual-5.1 {Tk_GetVisual, no matching visual} -constraints {
+ !havePseudocolorVisual
+} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 250 -height 100 -visual "pseudocolor 8"
+ wm geometry .t1 +0+0
+} -cleanup {
+ deleteWindows
+} -returnCodes error -result {couldn't find an appropriate visual}
-test visual-6.1 {Tk_GetVisual, no matching visual} {havePseudocolorVisual haveMultipleVisuals nonPortable} {
- catch {destroy .t1}
+
+test visual-6.1 {Tk_GetVisual, no matching visual} -constraints {
+ havePseudocolorVisual haveMultipleVisuals nonPortable
+} -setup {
+ deleteWindows
+} -body {
toplevel .t1 -width 250 -height 100 -visual "best"
wm geometry .t1 +0+0
update
winfo visual .t1
-} {pseudocolor}
+} -cleanup {
+ deleteWindows
+} -result {pseudocolor}
+
# These tests are non-portable due to variations in how many colors
# are already in use on the screen.
-
-if {[testConstraint defaultPseudocolor8]} {
+test visual-7.1 {Tk_GetColormap, "new"} -constraints {
+ defaultPseudocolor8 nonPortable
+} -setup {
+ deleteWindows
+} -body {
eatColors .t1
-}
-test visual-7.1 {Tk_GetColormap, "new"} {defaultPseudocolor8 nonPortable} {
toplevel .t2 -width 30 -height 20
wm geom .t2 +0+0
update
colorsFree .t2
-} {0}
-test visual-7.2 {Tk_GetColormap, "new"} {defaultPseudocolor8 nonPortable} {
- catch {destroy .t2}
+} -cleanup {
+ deleteWindows
+} -result {0}
+test visual-7.2 {Tk_GetColormap, "new"} -constraints {
+ defaultPseudocolor8 nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ eatColors .t1
toplevel .t2 -width 30 -height 20 -colormap new
wm geom .t2 +0+0
update
colorsFree .t2
-} {1}
-test visual-7.3 {Tk_GetColormap, copy from other window} {defaultPseudocolor8 nonPortable} {
- catch {destroy .t2}
+} -cleanup {
+ deleteWindows
+} -result {1}
+test visual-7.3 {Tk_GetColormap, copy from other window} -constraints {
+ defaultPseudocolor8 nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ eatColors .t1
toplevel .t3 -width 400 -height 50 -colormap new
wm geom .t3 +0+0
- catch {destroy .t2}
toplevel .t2 -width 30 -height 20 -colormap .t3
wm geom .t2 +0+0
update
destroy .t3
colorsFree .t2
-} {1}
-test visual-7.4 {Tk_GetColormap, copy from other window} {defaultPseudocolor8 nonPortable} {
- catch {destroy .t2}
+} -cleanup {
+ deleteWindows
+} -result {1}
+test visual-7.4 {Tk_GetColormap, copy from other window} -constraints {
+ defaultPseudocolor8 nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ eatColors .t1
toplevel .t3 -width 400 -height 50 -colormap new
wm geom .t3 +0+0
- catch {destroy .t2}
toplevel .t2 -width 30 -height 20 -colormap .
wm geom .t2 +0+0
update
destroy .t3
colorsFree .t2
-} {0}
-test visual-7.5 {Tk_GetColormap, copy from other window} {defaultPseudocolor8 nonPortable} {
- catch {destroy .t1}
- list [catch {
- toplevel .t1 -width 400 -height 50 -colormap .choke.lots
- } msg] $msg
-} {1 {bad window path name ".choke.lots"}}
-test visual-7.6 {Tk_GetColormap, copy from other window} {defaultPseudocolor8 haveOtherVisual nonPortable} {
- catch {destroy .t1}
- catch {destroy .t2}
+} -cleanup {
+ deleteWindows
+} -result {0}
+test visual-7.5 {Tk_GetColormap, copy from other window} -constraints {
+ defaultPseudocolor8 nonPortable
+} -setup {
+ deleteWindows
+} -body {
+ toplevel .t1 -width 400 -height 50 -colormap .choke.lots
+} -cleanup {
+ deleteWindows
+} -returnCodes error -result {bad window path name ".choke.lots"}
+test visual-7.6 {Tk_GetColormap, copy from other window} -constraints {
+ defaultPseudocolor8 haveOtherVisual nonPortable
+} -setup {
+ deleteWindows
+} -body {
toplevel .t1 -width 300 -height 150 -visual $other
wm geometry .t1 +0+0
- list [catch {toplevel .t2 -width 400 -height 50 -colormap .t1} msg] $msg
-} {1 {can't use colormap for .t1: incompatible visuals}}
-if {[testConstraint defaultPseudocolor8]} {
- catch {destroy .t1}
- catch {destroy .t2}
-}
+ toplevel .t2 -width 400 -height 50 -colormap .t1
+} -cleanup {
+ deleteWindows
+} -returnCodes error -result {can't use colormap for .t1: incompatible visuals}
+
-test visual-8.1 {Tk_FreeColormap procedure} {
+test visual-8.1 {Tk_FreeColormap procedure} -setup {
deleteWindows
+} -body {
toplevel .t1 -width 300 -height 180 -colormap new
wm geometry .t1 +0+0
foreach i {.t2 .t3 .t4} {
- toplevel $i -width 250 -height 150 -colormap .t1
- wm geometry $i +0+0
+ toplevel $i -width 250 -height 150 -colormap .t1
+ wm geometry $i +0+0
}
destroy .t1
destroy .t3
destroy .t4
update
-} {}
-test visual-8.2 {Tk_FreeColormap procedure} haveOtherVisual {
+} -cleanup {
deleteWindows
+} -result {}
+test visual-8.2 {Tk_FreeColormap procedure} -constraints haveOtherVisual -setup {
+ deleteWindows
+} -body {
toplevel .t1 -width 300 -height 180 -visual $other
wm geometry .t1 +0+0
foreach i {.t2 .t3 .t4} {
- toplevel $i -width 250 -height 150 -visual $other
- wm geometry $i +0+0
+ toplevel $i -width 250 -height 150 -visual $other
+ wm geometry $i +0+0
}
destroy .t2
destroy .t3
destroy .t4
update
-} {}
+} -cleanup {
+ deleteWindows
+} -result {}
+
deleteWindows
rename eatColors {}
@@ -298,3 +566,7 @@ rename colorsFree {}
# cleanup
cleanupTests
return
+
+# Local variables:
+# mode: tcl
+# End: \ No newline at end of file