* Completed conversion of Tk test suite to use tcltest.

FossilOrigin-Name: c483179b915e863450b867189ddfab962971936a

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