diff options
Diffstat (limited to 'tests/menubut.test')
| -rw-r--r-- | tests/menubut.test | 55 |
1 files changed, 23 insertions, 32 deletions
diff --git a/tests/menubut.test b/tests/menubut.test index e1042b1..86db6ae 100644 --- a/tests/menubut.test +++ b/tests/menubut.test @@ -6,29 +6,18 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: menubut.test,v 1.6 2001/05/21 14:07:33 tmh Exp $ +# RCS: @(#) $Id: menubut.test,v 1.7 2002/07/13 20:28:35 dgp Exp $ # XXX This test file is woefully incomplete right now. If any part # XXX of a procedure has tests then the whole procedure has tests, # XXX but many procedures have no tests. -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\" image" - puts "type, 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 # Create entries in the option database to be sure that geometry options # like border width have predictable values. @@ -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 +} menubutton .mb -text "Test" pack .mb update @@ -84,7 +75,7 @@ foreach test { {-wraplength 100 100 6x {bad screen distance "6x"}} } { set name [lindex $test 0] - test menubutton-1.$i {configuration options} { + test menubutton-1.$i {configuration options} testImageType { .mb configure $name [lindex $test 1] lindex [.mb configure $name] 4 } [lindex $test 2] @@ -181,7 +172,7 @@ test menubutton-4.3 {ConfigureMenuButton procedure} { (processing -width option) invoked from within ".mb1 configure -width abc"}} -test menubutton-4.4 {ConfigureMenuButton procedure} { +test menubutton-4.4 {ConfigureMenuButton procedure} testImageType { catch {destroy .mb1} eval image delete [image names] image create test image1 @@ -209,7 +200,7 @@ test menubutton-4.6 {ConfigureMenuButton procedure - bad direction} { # XXX Need to add tests for several procedures here. XXX test menubutton-5.1 {MenuButtonEventProc procedure} { - eval destroy [winfo children .] + deleteWindows menubutton .mb1 -bg #543210 rename .mb1 .mb2 set x {} @@ -220,38 +211,38 @@ test menubutton-5.1 {MenuButtonEventProc procedure} { } {.mb1 #543210 {} {}} test menubutton-6.1 {MenuButtonCmdDeletedProc procedure} { - eval destroy [winfo children .] + deleteWindows menubutton .mb1 rename .mb1 {} list [info command .mb*] [winfo children .] } {{} {}} -test menubutton-7.1 {ComputeMenuButtonGeometry procedure} { +test menubutton-7.1 {ComputeMenuButtonGeometry procedure} testImageType { catch {destroy .mb} menubutton .mb -image image1 -bd 4 -highlightthickness 0 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {38 23} -test menubutton-7.2 {ComputeMenuButtonGeometry procedure} { +test menubutton-7.2 {ComputeMenuButtonGeometry procedure} testImageType { catch {destroy .mb} menubutton .mb -image image1 -bd 1 -highlightthickness 2 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {36 21} -test menubutton-7.3 {ComputeMenuButtonGeometry procedure} { +test menubutton-7.3 {ComputeMenuButtonGeometry procedure} testImageType { catch {destroy .mb} menubutton .mb -image image1 -bd 0 -highlightthickness 2 -padx 5 -pady 5 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {34 19} -test menubutton-7.4 {ComputeMenuButtonGeometry procedure} { +test menubutton-7.4 {ComputeMenuButtonGeometry procedure} testImageType { catch {destroy .mb} menubutton .mb -image image1 -bd 2 -relief raised -width 40 \ -highlightthickness 2 pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {48 23} -test menubutton-7.5 {ComputeMenuButtonGeometry procedure} { +test menubutton-7.5 {ComputeMenuButtonGeometry procedure} testImageType { catch {destroy .mb} menubutton .mb -image image1 -bd 2 -relief raised -height 30 \ -highlightthickness 2 @@ -314,7 +305,7 @@ test menubutton-7.13 {ComputeMenuButtonGeometry procedure} {nonPortable fonts} { pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {78 28} -test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {unixOnly nonPortable} { +test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {testImageType unixOnly nonPortable} { # The following test is non-portable because the indicator's pixel # size varies to maintain constant absolute size. @@ -324,7 +315,7 @@ test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {unixOnly nonPortable pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {64 23} -test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {pcOnly nonPortable} { +test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {testImageType pcOnly nonPortable} { # The following test is non-portable because the indicator's pixel # size varies to maintain constant absolute size. @@ -336,7 +327,7 @@ test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {pcOnly nonPortable} } {65 23} set l [interp hidden] -eval destroy [winfo children .] +deleteWindows test menubutton-8.1 {menubutton vs hidden commands} { catch {destroy .mb} @@ -347,7 +338,7 @@ test menubutton-8.1 {menubutton vs hidden commands} { } [list {} $l] eval image delete [image names] -eval destroy [winfo children .] +deleteWindows option clear # cleanup |