diff options
Diffstat (limited to 'tests/border.test')
| -rw-r--r-- | tests/border.test | 56 |
1 files changed, 21 insertions, 35 deletions
diff --git a/tests/border.test b/tests/border.test index e59b405..55df1e4 100644 --- a/tests/border.test +++ b/tests/border.test @@ -5,39 +5,23 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: border.test,v 1.2 1999/04/16 01:51:34 stanton Exp $ +# RCS: @(#) $Id: border.test,v 1.3 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 testborder] != "testborder"} { - puts "testborder command not available; skipping tests" - ::tcltest::cleanupTests - return -} - -eval destroy [winfo children .] -wm geometry . {} -raise . +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 -# 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 borders. If not, just skip this whole -# test file. +testConstraint testborder [llength [info commands testborder]] -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 +if {[testConstraint pseudocolor8]} { + toplevel .t -visual {pseudocolor 8} -colormap new + wm geom .t +0+0 } -test border-1.1 {Tk_AllocBorderFromObj - converting internal reps} { +test border-1.1 {Tk_AllocBorderFromObj - converting internal reps} testborder { set x orange lindex $x 0 destroy .b1 @@ -45,7 +29,7 @@ test border-1.1 {Tk_AllocBorderFromObj - converting internal reps} { lindex $x 0 testborder orange } {{1 0}} -test border-1.3 {Tk_AllocBorderFromObj - discard stale border} { +test border-1.3 {Tk_AllocBorderFromObj - discard stale border} testborder { set x orange destroy .b1 .b2 button .b1 -bg $x -text First @@ -55,7 +39,7 @@ test border-1.3 {Tk_AllocBorderFromObj - discard stale border} { button .b2 -bg $x -text Second lappend result [testborder orange] } {{} {{1 1}}} -test border-1.2 {Tk_AllocBorderFromObj - reuse existing border} { +test border-1.2 {Tk_AllocBorderFromObj - reuse existing border} testborder { set x orange destroy .b1 .b2 button .b1 -bg $x -text First @@ -65,7 +49,7 @@ test border-1.2 {Tk_AllocBorderFromObj - reuse existing border} { pack .b1 .b2 -side top lappend result [testborder orange] } {{{1 1}} {{2 1}}} -test border-1.4 {Tk_AllocBorderFromObj - try other borders in list} { +test border-1.4 {Tk_AllocBorderFromObj - try other borders in list} {pseudocolor8 testborder} { set x purple destroy .b1 .b2 .t.b button .b1 -bg $x -text First @@ -80,7 +64,7 @@ test border-1.4 {Tk_AllocBorderFromObj - try other borders in list} { lappend result [testborder purple] } {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}} -test border-3.1 {Tk_Free3DBorder - reference counts} { +test border-3.1 {Tk_Free3DBorder - reference counts} {pseudocolor8 testborder} { set x purple destroy .b1 .b2 .t.b button .b1 -bg $x -text First @@ -98,7 +82,7 @@ test border-3.1 {Tk_Free3DBorder - reference counts} { destroy .t.b lappend result [testborder purple] } {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}} -test border-3.4 {Tk_Free3DBorder - unlinking from list} { +test border-3.4 {Tk_Free3DBorder - unlinking from list} {pseudocolor8 testborder} { destroy .b .t.b .t2 .t3 toplevel .t2 -visual {pseudocolor 8} -colormap new toplevel .t3 -visual {pseudocolor 8} -colormap new @@ -125,7 +109,7 @@ test border-3.4 {Tk_Free3DBorder - unlinking from list} { lappend result [testborder purple] } {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}} -test border-4.1 {FreeBorderObjProc} { +test border-4.1 {FreeBorderObjProc} testborder { destroy .b set x [format purple] button .b -bg $x -text .b1 @@ -175,7 +159,9 @@ test get-2.4 {Tk_GetReliefFromObj - error} { list [catch {.b configure -relief upanddown} msg] $msg } {1 {bad relief "upanddown": must be flat, groove, raised, ridge, solid, or sunken}} -destroy .t +if {[testConstraint pseudocolor8]} { + destroy .t +} # cleanup ::tcltest::cleanupTests |