summaryrefslogtreecommitdiff
path: root/tk/tests/menuDraw.test
diff options
context:
space:
mode:
Diffstat (limited to 'tk/tests/menuDraw.test')
-rw-r--r--tk/tests/menuDraw.test48
1 files changed, 27 insertions, 21 deletions
diff --git a/tk/tests/menuDraw.test b/tk/tests/menuDraw.test
index 7a1b660df85..f6902a73e0d 100644
--- a/tk/tests/menuDraw.test
+++ b/tk/tests/menuDraw.test
@@ -2,23 +2,23 @@
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
#
# RCS: @(#) $Id$
+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
-}
-
proc deleteWindows {} {
foreach i [winfo children .] {
catch [destroy $i]
@@ -29,16 +29,6 @@ deleteWindows
wm geometry . {}
raise .
-if {$tcl_platform(platform) == "windows" && ![info exists INTERACTIVE]} {
- puts " Some tests were skipped because they could not be performed"
- puts " automatically on this platform. If you wish to execute them"
- puts " interactively, set the TCL variable INTERACTIVE and re-run"
- puts " the test."
- set testConfig(menuInteractive) 0
-} else {
- set testConfig(menuInteractive) 1
-}
-
test menuDraw-1.1 {TkMenuInitializeDrawingFields} {
catch {destroy .m1}
list [menu .m1] [destroy .m1]
@@ -118,7 +108,7 @@ test menuDraw-6.6 {TkMenuConfigureEntryDrawOptions - bad state} {
menu .m1
.m1 add command -label "foo"
list [catch {.m1 entryconfigure 1 -state foo} msg] $msg [destroy .m1]
-} {1 {bad state value "foo": must be normal, active, or disabled} {}}
+} {1 {bad state "foo": must be active, normal, or disabled} {}}
test menuDraw-6.7 {TkMenuConfigureEntryDrawOptions - tkfont specified} {
catch {destroy .m1}
menu .m1
@@ -191,7 +181,7 @@ test menuDraw-7.2 {TkEventuallyRecomputeMenu - update pending} {
} {{} {}}
-test menuDraw-8.1 {TkRecomputeMenu} {menuInteractive} {
+test menuDraw-8.1 {TkRecomputeMenu} {pcOnly userInteraction} {
catch {destroy .m1}
menu .m1
.m1 configure -postcommand [.m1 add command -label foo]
@@ -506,7 +496,7 @@ test menuDraw-16.5 {TkPostSubMenu} {unixOnly} {
set tearoff [tkTearOffMenu .m1 40 40]
list [catch {$tearoff postcascade test} msg] $msg [destroy .m1] [destroy .m2]
} {1 {invalid command name "glorp"} {} {}}
-test menuDraw-16.6 {TkPostSubMenu} {menuInteractive} {
+test menuDraw-16.6 {TkPostSubMenu} {pcOnly userInteraction} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -532,7 +522,7 @@ test menuDraw-17.1 {AdjustMenuCoords - menubar} {unixOnly} {
}
list [$w postcascade 0] [. configure -menu ""] [destroy .m1] [destroy .m2]
} {{} {} {} {}}
-test menuDraw-17.2 {AdjustMenuCoords - menu} {menuInteractive} {
+test menuDraw-17.2 {AdjustMenuCoords - menu} {pcOnly userInteraction} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -543,4 +533,20 @@ test menuDraw-17.2 {AdjustMenuCoords - menu} {menuInteractive} {
list [$tearoff postcascade 0] [destroy .m1] [destroy .m2]
} {{} {} {}}
+# cleanup
deleteWindows
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+