diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2017-09-22 18:51:12 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2017-09-22 18:51:12 (GMT) |
commit | 3fa8e6dc88e8041b6cb88d1b1e9c05676d3346b7 (patch) | |
tree | 69afbb41089c8358615879f7cd3c4cf7997f4c7e /tk8.6/tests/visual.test | |
parent | a0e17db23c0fd7c771c0afce8cce350c98f90b02 (diff) | |
download | blt-3fa8e6dc88e8041b6cb88d1b1e9c05676d3346b7.zip blt-3fa8e6dc88e8041b6cb88d1b1e9c05676d3346b7.tar.gz blt-3fa8e6dc88e8041b6cb88d1b1e9c05676d3346b7.tar.bz2 |
update to tcl/tk 8.6.7
Diffstat (limited to 'tk8.6/tests/visual.test')
-rw-r--r-- | tk8.6/tests/visual.test | 570 |
1 files changed, 0 insertions, 570 deletions
diff --git a/tk8.6/tests/visual.test b/tk8.6/tests/visual.test deleted file mode 100644 index 2f5c34a..0000000 --- a/tk8.6/tests/visual.test +++ /dev/null @@ -1,570 +0,0 @@ -# This file is a Tcl script to test the visual- and colormap-handling -# procedures in the file tkVisual.c. It is organized in the standard -# fashion for Tcl tests. -# -# Copyright (c) 1994 The Regents of the University of California. -# Copyright (c) 1994-1995 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. -# All rights reserved. - -package require tcltest 2.2 -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 -} - -# 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) -} - -# If more than one visual type is available for the screen, pick one -# that is *not* the default. - -set default "[winfo visual .] [winfo depth .]" -set avail [winfo visualsavailable .] -set other {} -if {[llength $avail] > 1} { - foreach visual $avail { - 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} -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]" -} -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]" -} -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} -constraints { - haveOtherVisual -} -setup { - deleteWindows -} -body { - toplevel .t1 -width 250 -height 100 -visual $other - wm geom .t1 +0+0 - set result [toplevel .t2 -gorp 80 -visual .t1] - update - 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]" -} -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} - - -test visual-3.1 {Tk_GetVisual, parsing visual string} -setup { - deleteWindows -} -body { - toplevel .t1 -width 250 -height 100 \ - -visual "[winfo visual .][winfo depth .]" - wm geometry .t1 +0+0 - update - concat "[winfo visual .t1] [winfo depth .t1]" -} -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} -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 -} -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]"} -} -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} -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} -constraints { - havePseudocolorVisual haveMultipleVisuals nonPortable -} -setup { - deleteWindows -} -body { - toplevel .t1 -width 250 -height 100 -visual "best" - wm geometry .t1 +0+0 - update - winfo visual .t1 -} -cleanup { - deleteWindows -} -result {pseudocolor} - - -# These tests are non-portable due to variations in how many colors -# are already in use on the screen. -test visual-7.1 {Tk_GetColormap, "new"} -constraints { - defaultPseudocolor8 nonPortable -} -setup { - deleteWindows -} -body { - eatColors .t1 - toplevel .t2 -width 30 -height 20 - wm geom .t2 +0+0 - update - colorsFree .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 -} -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 - toplevel .t2 -width 30 -height 20 -colormap .t3 - wm geom .t2 +0+0 - update - destroy .t3 - colorsFree .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 - toplevel .t2 -width 30 -height 20 -colormap . - wm geom .t2 +0+0 - update - destroy .t3 - colorsFree .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 - 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} -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 - } - destroy .t1 - destroy .t3 - destroy .t4 - update -} -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 - } - destroy .t2 - destroy .t3 - destroy .t4 - update -} -cleanup { - deleteWindows -} -result {} - - -deleteWindows -rename eatColors {} -rename colorsFree {} - -# cleanup -cleanupTests -return - -# Local variables: -# mode: tcl -# End: |