diff options
Diffstat (limited to 'tests/menubut.test')
-rw-r--r-- | tests/menubut.test | 48 |
1 files changed, 32 insertions, 16 deletions
diff --git a/tests/menubut.test b/tests/menubut.test index 9bdf04c..89d46d8 100644 --- a/tests/menubut.test +++ b/tests/menubut.test @@ -3,27 +3,27 @@ # # Copyright (c) 1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# All rights reserved. # -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: menubut.test,v 1.2 1998/09/14 18:23:49 stanton Exp $ +# RCS: @(#) $Id: menubut.test,v 1.3 1999/04/16 01:51:39 stanton 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 } -if {[info procs test] != "test"} { - source defs -} - foreach i [winfo children .] { destroy $i } @@ -51,7 +51,7 @@ foreach test { {unknown color name "non-existent"}} {-activeforeground #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} - {-anchor nw nw bogus {bad anchor position "bogus": must be n, ne, e, se, s, sw, w, nw, or center}} + {-anchor nw nw bogus {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center}} {-background #ff0000 #ff0000 non-existent {unknown color name "non-existent"}} {-bd 4 4 badValue {bad screen distance "badValue"}} @@ -59,7 +59,7 @@ foreach test { {-bitmap questhead questhead badValue {bitmap "badValue" not defined}} {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}} {-cursor arrow arrow badValue {bad cursor spec "badValue"}} - {-direction below below badValue {bad direction value "badValue": must be above, below, left, right, or flush}} + {-direction below below badValue {bad direction "badValue": must be above, below, flush, left, or right}} {-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}} {-fg #110022 #110022 bogus {unknown color name "bogus"}} {-font {Helvetica 12} {Helvetica 12} {} {font "" doesn't exist}} @@ -74,8 +74,8 @@ foreach test { {-menu "any old string" "any old string" {} {}} {-padx 12 12 420x {bad screen distance "420x"}} {-pady 12 12 420x {bad screen distance "420x"}} - {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}} - {-state normal normal bogus {bad state value "bogus": must be normal, active, or disabled}} + {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}} + {-state normal normal bogus {bad state "bogus": must be active, disabled, or normal}} {-takefocus "any string" "any string" {} {}} {-text "Sample text" {Sample text} {} {}} {-textvariable i i {} {}} @@ -122,7 +122,7 @@ test menubutton-3.1 {MenuButtonWidgetCmd procedure} { } {1 {wrong # args: should be ".mb option ?arg arg ...?"}} test menubutton-3.2 {ButtonWidgetCmd procedure, "cget" option} { list [catch {.mb c} msg] $msg -} {1 {bad option "c": must be cget or configure}} +} {1 {ambiguous option "c": must be cget or configure}} test menubutton-3.3 {ButtonWidgetCmd procedure, "cget" option} { list [catch {.mb cget} msg] $msg } {1 {wrong # args: should be ".mb cget option"}} @@ -204,7 +204,7 @@ test menubutton-4.6 {ConfigureMenuButton procedure - bad direction} { menubutton .mb -text "Test" list [catch {.mb configure -direction badValue} msg] $msg \ [.mb cget -direction] [destroy .mb] -} {1 {bad direction value "badValue": must be above, below, left, right, or flush} below {}} +} {1 {bad direction "badValue": must be above, below, flush, left, or right} below {}} # XXX Need to add tests for several procedures here. XXX @@ -314,7 +314,7 @@ test menubutton-7.13 {ComputeMenuButtonGeometry procedure} {fonts} { pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {78 28} -test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {unix nonPortable} { +test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {unixOnly nonPortable} { # The following test is non-portable because the indicator's pixel # size varies to maintain constant absolute size. @@ -324,7 +324,7 @@ test menubutton-7.14 {ComputeMenuButtonGeometry procedure} {unix nonPortable} { pack .mb list [winfo reqwidth .mb] [winfo reqheight .mb] } {64 23} -test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {pc nonPortable} { +test menubutton-7.15 {ComputeMenuButtonGeometry procedure} {pcOnly nonPortable} { # The following test is non-portable because the indicator's pixel # size varies to maintain constant absolute size. @@ -350,3 +350,19 @@ eval image delete [image names] eval destroy [winfo children .] option clear +# cleanup +::tcltest::cleanupTests +return + + + + + + + + + + + + + |