summaryrefslogtreecommitdiffstats
path: root/tk8.6/tests/visual.test
diff options
context:
space:
mode:
authorWilliam Joye <wjoye@cfa.harvard.edu>2017-09-22 18:51:12 (GMT)
committerWilliam Joye <wjoye@cfa.harvard.edu>2017-09-22 18:51:12 (GMT)
commit3fa8e6dc88e8041b6cb88d1b1e9c05676d3346b7 (patch)
tree69afbb41089c8358615879f7cd3c4cf7997f4c7e /tk8.6/tests/visual.test
parenta0e17db23c0fd7c771c0afce8cce350c98f90b02 (diff)
downloadblt-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.test570
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: