* Completed conversion of Tk test suite to use tcltest.

1 files changed, 36 insertions, 45 deletions

diff --git a/tests/button.test b/tests/button.test
index ed0b7ee..d7f9028 100644
--- a/tests/button.test
+++ b/tests/button.test
@@ -7,25 +7,14 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: button.test,v 1.11 2002/06/17 10:54:29 drh Exp $
+# RCS: @(#) $Id: button.test,v 1.12 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 {[lsearch [image types] test] < 0} {
-    puts "This application hasn't been compiled with the \"test\""
-    puts "image, so I can't run this test.  Are you sure you're using"
-    puts "tktest instead of wish?"
-    ::tcltest::cleanupTests
-    return
-}
-
-foreach i [winfo children .] {
-    destroy $i
-}
-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
 
 proc bogusTrace args {
     error "trace aborted"
@@ -41,7 +30,9 @@ option add *Button.highlightThickness 2
 option add *Button.font {Helvetica -12 bold}
 
 eval image delete [image names]
-image create test image1
+if {[testConstraint testImageType]} {
+    image create test image1
+}
 label .l -text Label
 button .b -text Button
 checkbutton .c -text Checkbutton
@@ -109,19 +100,19 @@ foreach test {
     set classes [lindex $test 5]
     foreach w {.l .b .c .r} hasOption [lindex $test 5] {
 	if $hasOption {
-	    test button-1.$i {configuration options} {
+	    test button-1.$i {configuration options} testImageType {
 		$w configure $name [lindex $test 1]
 		lindex [$w configure $name] 4
 	    } [lindex $test 2]
 	    incr i
 	    if {[lindex $test 3] != ""} {
-		test button-1.$i {configuration options} {
+		test button-1.$i {configuration options} testImageType {
 		    list [catch {$w configure $name [lindex $test 3]} msg] $msg
 		} [list 1 [lindex $test 4]]
 	    }
 	    $w configure $name [lindex [$w configure $name] 3]
 	} else {
-	    test button-1.$i {configuration options} {
+	    test button-1.$i {configuration options} testImageType {
 		list [catch {$w configure $name [lindex $test 1]} msg] $msg
 	    } "1 {unknown option \"$name\"}"
 	}
@@ -412,7 +403,7 @@ test button-4.50 {ButtonWidgetCmd procedure, "toggle" option} {
     while executing
 ".c toggle"}}
 
-test button-5.1 {DestroyButton procedure} {
+test button-5.1 {DestroyButton procedure} testImageType {
     image create test image1
     button .b1 -image image1
     button .b2 -fg #ff0000 -text "Button 2"
@@ -422,7 +413,7 @@ test button-5.1 {DestroyButton procedure} {
     set x 1
     pack .b1 .b2 .b3 .b4 .b5
     update
-    eval destroy [winfo children .]
+    deleteWindows
 } {}
 
 test button-6.1 {ConfigureButton - textvariable trace} {
@@ -452,7 +443,7 @@ test button-6.2 {ConfigureButton - variable traces} {
     .b1 toggle
     set y
 } {1}
-test button-6.3 {ConfigureButton - image handling} {
+test button-6.3 {ConfigureButton - image handling} testImageType {
     catch {destroy .b1}
     eval image delete [image names]
     image create test image1
@@ -545,7 +536,7 @@ test button-6.16 {ConfigureButton - -width option} {
     (processing -width option)
     invoked from within
 ".b1 configure -width abc"}}
-test button-6.17 {ConfigureButton - -height option} {
+test button-6.17 {ConfigureButton - -height option} testImageType {
     catch {destroy .b1}
     eval image delete [image names]
     image create test image1
@@ -582,7 +573,7 @@ test button-7.1 {ButtonEventProc procedure} {
     set x
 } {0 {}}
 test button-7.2 {ButtonEventProc procedure} {
-    eval destroy [winfo children .]
+    deleteWindows
     button .b1 -bg #543210
     rename .b1 .b2
     set x {}
@@ -593,7 +584,7 @@ test button-7.2 {ButtonEventProc procedure} {
 } {.b1 #543210 {} {}}
 
 test button-8.1 {ButtonCmdDeletedProc procedure} {
-    eval destroy [winfo children .]
+    deleteWindows
     button .b1
     rename .b1 {}
     list [info command .b*] [winfo children .]
@@ -649,20 +640,20 @@ test button-9.5 {TkInvokeButton procedure} {
     while executing
 ".b1 invoke"} red}
 test button-9.6 {TkInvokeButton procedure} {
-    eval destroy [winfo children .]
+    deleteWindows
     set result untouched
     button .b1 -command {set result invoked}
     list [catch {.b1 invoke} msg] $msg $result
 } {0 invoked invoked}
 test button-9.7 {TkInvokeButton procedure} {
-    eval destroy [winfo children .]
+    deleteWindows
     set result untouched
     set x 0
     checkbutton .b1 -variable x -command {set result "invoked $x"}
     list [catch {.b1 invoke} msg] $msg $result
 } {0 {invoked 1} {invoked 1}}
 test button-9.8 {TkInvokeButton procedure} {
-    eval destroy [winfo children .]
+    deleteWindows
     set result untouched
     set x 0
     radiobutton .b1 -variable x -value red -command {set result "invoked $x"}
@@ -670,7 +661,7 @@ test button-9.8 {TkInvokeButton procedure} {
 } {0 {invoked red} {invoked red}}
 
 test button-10.1 {ButtonVarProc procedure} {
-    eval destroy [winfo children .]
+    deleteWindows
     set x 1
     checkbutton .b1 -variable x
     unset x
@@ -682,7 +673,7 @@ test button-10.1 {ButtonVarProc procedure} {
     lappend result $x
 } {0 1 1}
 test button-10.2 {ButtonVarProc procedure} {
-    eval destroy [winfo children .]
+    deleteWindows
     set x 0
     checkbutton .b1 -variable x
     set x 44
@@ -690,7 +681,7 @@ test button-10.2 {ButtonVarProc procedure} {
     set x
 } {1}
 test button-10.3 {ButtonVarProc procedure} {
-    eval destroy [winfo children .]
+    deleteWindows
     set x 1
     checkbutton .b1 -variable x
     set x 44
@@ -698,7 +689,7 @@ test button-10.3 {ButtonVarProc procedure} {
     set x
 } {1}
 test button-10.4 {ButtonVarProc procedure} {
-    eval destroy [winfo children .]
+    deleteWindows
     set x 0
     checkbutton .b1 -variable x
     set x 1
@@ -706,7 +697,7 @@ test button-10.4 {ButtonVarProc procedure} {
     set x
 } {0}
 test button-10.5 {ButtonVarProc procedure} {
-    eval destroy [winfo children .]
+    deleteWindows
     set x 1
     checkbutton .b1 -variable x
     set x 1
@@ -714,7 +705,7 @@ test button-10.5 {ButtonVarProc procedure} {
     set x
 } {0}
 test button-10.6 {ButtonVarProc procedure} {
-    eval destroy [winfo children .]
+    deleteWindows
     set x 0
     checkbutton .b1 -variable x
     set x 0
@@ -722,7 +713,7 @@ test button-10.6 {ButtonVarProc procedure} {
     set x
 } {1}
 test button-10.7 {ButtonVarProc procedure} {
-    eval destroy [winfo children .]
+    deleteWindows
     set x 1
     checkbutton .b1 -variable x
     set x 0
@@ -731,7 +722,7 @@ test button-10.7 {ButtonVarProc procedure} {
 } {1}
 test button-10.8 {ButtonVarProc procedure, can't read variable} {
     # This test does nothing but produce a core dump if there's a prbblem.
-    eval destroy [winfo children .]
+    deleteWindows
     catch {unset a}
     checkbutton .b1 -variable a
     unset a
@@ -740,7 +731,7 @@ test button-10.8 {ButtonVarProc procedure, can't read variable} {
 } {}
 
 test button-11.1 {ButtonTextVarProc procedure} {
-    eval destroy [winfo children .]
+    deleteWindows
     set x Label
     button .b1 -textvariable x
     unset x
@@ -749,7 +740,7 @@ test button-11.1 {ButtonTextVarProc procedure} {
     lappend result [lindex [.b1 configure -text] 4]
 } {Label Label New}
 test button-11.2 {ButtonTextVarProc procedure} {
-    eval destroy [winfo children .]
+    deleteWindows
     # Windows buttons have a default min width, so we have to
     # set this to be longer to force the wider button.
     set x ExtraLongLabel
@@ -760,8 +751,8 @@ test button-11.2 {ButtonTextVarProc procedure} {
     list [lindex [.b1 configure -text] 4] [expr $old == $new]
 } {New 0}
 
-test button-12.1 {ButtonImageProc procedure} {
-    eval destroy [winfo children .]
+test button-12.1 {ButtonImageProc procedure} testImageType {
+    deleteWindows
     eval image delete [image names]
     image create test image1
     label .b1 -image image1 -padx 0 -pady 0 -bd 0
@@ -771,7 +762,7 @@ test button-12.1 {ButtonImageProc procedure} {
     lappend result [winfo reqwidth .b1] [winfo reqheight .b1]
 } {30 15 80 100}
 
-eval destroy [winfo children .]
+deleteWindows
 set l [interp hidden]
 
 test button-13.1 {button widget vs hidden commands} {
@@ -782,7 +773,7 @@ test button-13.1 {button widget vs hidden commands} {
     list [winfo children .] [interp hidden]
 } [list {} $l]
 
-eval destroy [winfo children .]
+deleteWindows
 
 option clear