diff options
author | dgp <dgp@users.sourceforge.net> | 2002-07-14 05:48:45 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2002-07-14 05:48:45 (GMT) |
commit | f79b432c7c47051e0c7e11bd52e82547ad7aacf2 (patch) | |
tree | 506cf7b5383406d4969854b8209566f9c0b690c6 /tests/color.test | |
parent | 213541e4a3a5a49415c0f9f8d37a5cbce28f89f7 (diff) | |
download | tk-f79b432c7c47051e0c7e11bd52e82547ad7aacf2.zip tk-f79b432c7c47051e0c7e11bd52e82547ad7aacf2.tar.gz tk-f79b432c7c47051e0c7e11bd52e82547ad7aacf2.tar.bz2 |
* Completed conversion of Tk test suite to use tcltest.
Diffstat (limited to 'tests/color.test')
-rw-r--r-- | tests/color.test | 96 |
1 files changed, 38 insertions, 58 deletions
diff --git a/tests/color.test b/tests/color.test index b7fed15..fec3748 100644 --- a/tests/color.test +++ b/tests/color.test @@ -5,21 +5,16 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: color.test,v 1.5 2000/11/02 01:18:35 hobbs Exp $ +# RCS: @(#) $Id: color.test,v 1.6 2002/07/14 05:48:46 dgp Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] -} - -if {[info commands testcolor] != "testcolor"} { - puts "testcolor command not available; skipping tests" - ::tcltest::cleanupTests - return -} +package require tcltest 2.1 +namespace import -force tcltest::configure +namespace import -force tcltest::testsDirectory +configure -testdir [file join [pwd] [file dirname [info script]]] +configure -loadfile [file join [testsDirectory] constraints.tcl] +tcltest::loadTestedCommands -eval destroy [winfo children .] -wm geometry . {} -raise . +testConstraint testcolor [llength [info commands testcolor]] # cname -- # Returns a proper name for a color, given its intensities. @@ -102,39 +97,24 @@ proc colorsFree {w {red 31} {green 245} {blue 192}} { && ([lindex $vals 2]/256 == $blue) } -# Create a top-level with its own colormap (so we can test under -# controlled conditions), then check to make sure that the visual -# is color-mapped with 256 colors. If not, just skip this whole -# test file. +if {[testConstraint psuedocolor8]} { + toplevel .t -visual {pseudocolor 8} -colormap new + wm geom .t +0+0 + mkColors .t.c 40 6 0 0 0 0 6 0 0 0 40 + pack .t.c + update -if [catch {toplevel .t -visual {pseudocolor 8} -colormap new}] { - ::tcltest::cleanupTests - return -} -wm geom .t +0+0 -if {[winfo depth .t] != 8} { - destroy .t - ::tcltest::cleanupTests - return -} -mkColors .t.c 40 6 0 0 0 0 6 0 0 0 40 -pack .t.c -update -if ![colorsFree .t.c 101 233 17] { - destroy .t - ::tcltest::cleanupTests - return -} -mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0 -pack .t.c2 -if [colorsFree .t.c] { - destroy .t - ::tcltest::cleanupTests - return + testConstraint colorsFree [colorsFree .t.c 101 233 17] + + if {[testConstraint colorsFree]} { + mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0 + pack .t.c2 + testConstraint colorsFree [expr {![colorsFree .t.c]}] + } + destroy .t.c .t.c2 } -destroy .t.c .t.c2 -test color-1.1 {Tk_AllocColorFromObj - converting internal reps} { +test color-1.1 {Tk_AllocColorFromObj - converting internal reps} colorsFree { set x green lindex $x 0 destroy .b1 @@ -142,7 +122,7 @@ test color-1.1 {Tk_AllocColorFromObj - converting internal reps} { lindex $x 0 testcolor green } {{1 0}} -test color-1.2 {Tk_AllocColorFromObj - discard stale color} { +test color-1.2 {Tk_AllocColorFromObj - discard stale color} colorsFree { set x green destroy .b1 .b2 button .b1 -foreground $x -text First @@ -152,7 +132,7 @@ test color-1.2 {Tk_AllocColorFromObj - discard stale color} { button .b2 -foreground $x -text Second lappend result [testcolor green] } {{} {{1 1}}} -test color-1.3 {Tk_AllocColorFromObj - reuse existing color} { +test color-1.3 {Tk_AllocColorFromObj - reuse existing color} colorsFree { set x green destroy .b1 .b2 button .b1 -foreground $x -text First @@ -162,7 +142,7 @@ test color-1.3 {Tk_AllocColorFromObj - reuse existing color} { pack .b1 .b2 -side top lappend result [testcolor green] } {{{1 1}} {{2 1}}} -test color-1.4 {Tk_AllocColorFromObj - try other colors in list} { +test color-1.4 {Tk_AllocColorFromObj - try other colors in list} colorsFree { set x purple destroy .b1 .b2 .t.b button .b1 -foreground $x -text First @@ -177,30 +157,30 @@ test color-1.4 {Tk_AllocColorFromObj - try other colors in list} { lappend result [testcolor purple] } {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}} -test color-2.1 {Tk_GetColor procedure} { +test color-2.1 {Tk_GetColor procedure} colorsFree { c255 [winfo rgb .t #FF0000] } {255 0 0} -test color-2.2 {Tk_GetColor procedure} { +test color-2.2 {Tk_GetColor procedure} colorsFree { list [catch {winfo rgb .t noname} msg] $msg } {1 {unknown color name "noname"}} -test color-2.3 {Tk_GetColor procedure} { +test color-2.3 {Tk_GetColor procedure} colorsFree { c255 [winfo rgb .t #123456] } {18 52 86} -test color-2.4 {Tk_GetColor procedure} { +test color-2.4 {Tk_GetColor procedure} colorsFree { list [catch {winfo rgb .t #xyz} msg] $msg } {1 {invalid color name "#xyz"}} -test color-2.5 {Tk_GetColor procedure} { +test color-2.5 {Tk_GetColor procedure} colorsFree { winfo rgb .t #00FF00 } {0 65535 0} -test color-2.6 {Tk_GetColor procedure} {nonPortable} { +test color-2.6 {Tk_GetColor procedure} {colorsFree nonPortable} { # Red doesn't always map to *pure* red winfo rgb .t red } {65535 0 0} -test color-2.7 {Tk_GetColor procedure} { +test color-2.7 {Tk_GetColor procedure} colorsFree { winfo rgb .t #ff0000 } {65535 0 0} -test color-3.1 {Tk_FreeColor procedure, reference counting} { +test color-3.1 {Tk_FreeColor procedure, reference counting} colorsFree { eval destroy [winfo child .t] mkColors .t.c 40 6 0 240 240 0 -6 0 0 0 -40 pack .t.c @@ -214,7 +194,7 @@ test color-3.1 {Tk_FreeColor procedure, reference counting} { .t.c2 delete $last lappend result [colorsFree .t] } {0 1} -test color-3.2 {Tk_FreeColor procedure, flushing stressed cmap information} { +test color-3.2 {Tk_FreeColor procedure, flushing stressed cmap information} colorsFree { eval destroy [winfo child .t] mkColors .t.c 40 6 0 240 240 0 -6 0 0 0 -40 pack .t.c @@ -224,7 +204,7 @@ test color-3.2 {Tk_FreeColor procedure, flushing stressed cmap information} { update closest .t 241 241 1 } {240 240 0} -test color-3.3 {Tk_FreeColorFromObj - reference counts} { +test color-3.3 {Tk_FreeColorFromObj - reference counts} colorsFree { set x purple destroy .b1 .b2 .t.b button .b1 -foreground $x -text First @@ -242,7 +222,7 @@ test color-3.3 {Tk_FreeColorFromObj - reference counts} { destroy .t.b lappend result [testcolor purple] } {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}} -test color-3.4 {Tk_FreeColorFromObj - unlinking from list} { +test color-3.4 {Tk_FreeColorFromObj - unlinking from list} colorsFree { destroy .b .t.b .t2 .t3 toplevel .t2 -visual {pseudocolor 8} -colormap new toplevel .t3 -visual {pseudocolor 8} -colormap new @@ -269,7 +249,7 @@ test color-3.4 {Tk_FreeColorFromObj - unlinking from list} { lappend result [testcolor purple] } {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}} -test color-4.1 {FreeColorObjProc} { +test color-4.1 {FreeColorObjProc} colorsFree { destroy .b set x [format purple] button .b -foreground $x -text .b1 |