* Merged 8.1 branch into the main trunk

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
+
+
+
+
+
+
+
+
+
+
+
+
+