summaryrefslogtreecommitdiffstats
path: root/tests/border.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/border.test')
-rw-r--r--tests/border.test56
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