summaryrefslogtreecommitdiffstats
path: root/tests/menu.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/menu.test')
-rw-r--r--tests/menu.test500
1 files changed, 286 insertions, 214 deletions
diff --git a/tests/menu.test b/tests/menu.test
index a4399b5..7b8ba02 100644
--- a/tests/menu.test
+++ b/tests/menu.test
@@ -2,32 +2,27 @@
# organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995-1997 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: menu.test,v 1.2 1998/09/14 18:23:48 stanton Exp $
+# RCS: @(#) $Id: menu.test,v 1.3 1999/04/16 01:51:39 stanton 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\" 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
-}
-
-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
-}
+# Some tests require user interaction on non-unix platform
+set ::tcltest::testConfig(nonUnixUserInteraction) \
+ [expr {$::tcltest::testConfig(userInteraction) || \
+ $::tcltest::testConfig(unixOnly)}]
proc deleteWindows {} {
foreach i [winfo children .] {
@@ -164,16 +159,16 @@ test menu-1.14 {Tk_MenuCmd procedure} {
catch {destroy .m1}
menu .m1
set i 1
-foreach test {
+foreach configTest {
{-activebackground #012345 #012345 non-existent
{unknown color name "non-existent"}}
- {-activeborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
+ {-activeborderwidth 1.3 1.3 badValue {bad screen distance "badValue"}}
{-activeforeground #ff0000 #ff0000 non-existent
{unknown color name "non-existent"}}
{-background #ff0000 #ff0000 non-existent
{unknown color name "non-existent"}}
{-bg #110022 #110022 bogus {unknown color name "bogus"}}
- {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
+ {-borderwidth 1.3 1.3 badValue {bad screen distance "badValue"}}
{-cursor arrow arrow badValue {bad cursor spec "badValue"}}
{-disabledforeground #00ff00 #00ff00 xyzzy {unknown color name "xyzzy"}}
{-fg #110022 #110022 bogus {unknown color name "bogus"}}
@@ -182,23 +177,27 @@ foreach test {
{font "" doesn't exist}}
{-foreground #110022 #110022 bogus {unknown color name "bogus"}}
{-postcommand "any old string" "any old string" {} {}}
- {-relief groove groove 1.5 {bad relief type "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-relief groove groove 1.5 {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken}}
{-selectcolor #110022 #110022 bogus {unknown color name "bogus"}}
{-takefocus "any string" "any string" {} {}}
{-tearoff 0 0}
{-tearoff 1 1}
{-tearoffcommand "any old string" "any old string" {} {}}
} {
- set name [lindex $test 0]
- test menu-2.$i {configuration options} {
- .m1 configure $name [lindex $test 1]
+ set name [lindex $configTest 0]
+ set value [lindex $configTest 1]
+ set result [lindex $configTest 2]
+ test menu-2.$i [list configuration options $name $value $result] {
+ .m1 configure $name $value
lindex [.m1 configure $name] 4
- } [lindex $test 2]
+ } $result
incr i
- if {[lindex $test 3] != ""} {
- test menu-2.$i {configuration options} {
- list [catch {.m1 configure $name [lindex $test 3]} msg] $msg
- } [list 1 [lindex $test 4]]
+ if {[lindex $configTest 3] != ""} {
+ set value [lindex $configTest 3]
+ set result [lindex $configTest 4]
+ test menu-2.$i [list configuration options $name $value $result] {
+ list [catch {.m1 configure $name $value} msg] $msg
+ } [list 1 $result]
}
.m1 configure $name [lindex [.m1 configure $name] 3]
incr i
@@ -221,7 +220,7 @@ menu .m2
.m1 add radiobutton -label "radiobutton" -variable radio
image create photo image1 -file [file join $tk_library demos images earth.gif]
-foreach test {
+foreach configTest {
{-activebackground
{{#012345
{{unknown option "-activebackground"} #012345 #012345
@@ -240,7 +239,7 @@ foreach test {
}
{-activeforeground
{{#ff0000
- {{unknown option "-activeforeground"}
+ {{unknown option "-activeforeground"}
#ff0000 #ff0000 {unknown option "-activeforeground"} #ff0000 #ff0000
}
}
@@ -256,7 +255,7 @@ foreach test {
}
{-accelerator
{{"Ctrl+S"
- {{unknown option "-accelerator"}
+ {{unknown option "-accelerator"}
"Ctrl+S" "Ctrl+S" {unknown option "-accelerator"}
"Ctrl+S" "Ctrl+S"
}
@@ -279,8 +278,8 @@ foreach test {
}
{-bitmap
{{questhead
- {{unknown option "-bitmap"} questhead questhead
- {unknown option "-bitmap"} questhead questhead
+ {{unknown option "-bitmap"} questhead questhead
+ {unknown option "-bitmap"} questhead questhead
}
}
{badValue
@@ -295,22 +294,23 @@ foreach test {
}
{-columnbreak
{{1
- {{unknown option "-columnbreak"} 1 1 {unknown option "-columnbreak"} 1 1}
+ {{unknown option "-columnbreak"} 1 1
+ {unknown option "-columnbreak"} 1 1}
}}
}
{-command
{{beep
- {{unknown option "-command"} beep beep
- {unknown option "-command"} beep beep
+ {{unknown option "-command"} beep beep
+ {unknown option "-command"} beep beep
}
}}
}
{-font
{{-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
- {{unknown option "-font"}
+ {{unknown option "-font"}
-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
- {unknown option "-font"}
+ {unknown option "-font"}
-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
-Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
}
@@ -327,8 +327,8 @@ foreach test {
}
{-foreground
{{#110022
- {{unknown option "-foreground"} #110022 #110022
- {unknown option "-foreground"} #110022 #110022
+ {{unknown option "-foreground"} #110022 #110022
+ {unknown option "-foreground"} #110022 #110022
}
}
{non-existent
@@ -343,8 +343,8 @@ foreach test {
}
{-image
{{image1
- {{unknown option "-image"} image1 image1
- {unknown option "-image"} image1 image1
+ {{unknown option "-image"} image1 image1
+ {unknown option "-image"} image1 image1
}
}
{bogus
@@ -368,58 +368,58 @@ foreach test {
}
{-indicatoron
{{1
- {{unknown option "-indicatoron"}
- {unknown option "-indicatoron"}
- {unknown option "-indicatoron"}
- {unknown option "-indicatoron"} 1 1
+ {{unknown option "-indicatoron"}
+ {unknown option "-indicatoron"}
+ {unknown option "-indicatoron"}
+ {unknown option "-indicatoron"} 1 1
}
}}
}
{-label
{{test
- {{unknown option "-label"} test test
- {unknown option "-label"} test test
+ {{unknown option "-label"} test test
+ {unknown option "-label"} test test
}
}}
}
{-menu
{{.m2
- {{unknown option "-menu"}
- {unknown option "-menu"} .m2
- {unknown option "-menu"}
- {unknown option "-menu"}
- {unknown option "-menu"}
+ {{unknown option "-menu"}
+ {unknown option "-menu"} .m2
+ {unknown option "-menu"}
+ {unknown option "-menu"}
+ {unknown option "-menu"}
}
}}
}
{-offvalue
{{off
- {{unknown option "-offvalue"}
- {unknown option "-offvalue"}
+ {{unknown option "-offvalue"}
+ {unknown option "-offvalue"}
+ {unknown option "-offvalue"}
{unknown option "-offvalue"}
- {unknown option "-offvalue"}
off
- {unknown option "-offvalue"}
+ {unknown option "-offvalue"}
}
}}
}
{-onvalue
{{on
- {{unknown option "-onvalue"}
- {unknown option "-onvalue"}
- {unknown option "-onvalue"}
- {unknown option "-onvalue"}
+ {{unknown option "-onvalue"}
+ {unknown option "-onvalue"}
+ {unknown option "-onvalue"}
+ {unknown option "-onvalue"}
on
- {unknown option "-onvalue"}
+ {unknown option "-onvalue"}
}
}}
}
{-selectcolor
{{#110022
- {{unknown option "-selectcolor"}
- {unknown option "-selectcolor"}
- {unknown option "-selectcolor"}
- {unknown option "-selectcolor"}
+ {{unknown option "-selectcolor"}
+ {unknown option "-selectcolor"}
+ {unknown option "-selectcolor"}
+ {unknown option "-selectcolor"}
#110022
#110022
}
@@ -463,8 +463,7 @@ foreach test {
}
{-state
{{normal
- {normal normal normal
- {unknown option "-state"} normal normal
+ {normal normal normal {unknown option "-state"} normal normal
}
}}
}
@@ -506,13 +505,13 @@ foreach test {
}}
}
} {
- set name [lindex $test 0]
- foreach attempt [lindex $test 1] {
+ set name [lindex $configTest 0]
+ foreach attempt [lindex $configTest 1] {
set value [lindex $attempt 0]
set options [lindex $attempt 1]
foreach item {0 1 2 3 4 5} {
catch {unset msg}
- test menu-2.$i [list entry configuration options $name $item $value] {
+ test menu-2.$i [list entry configuration options $name $item $value [.m1 type $item]] {
set result [catch {.m1 entryconfigure $item $name $value} msg]
if {$result == 1} {
set msg
@@ -534,7 +533,7 @@ test menu-3.1 {MenuWidgetCmd procedure} {
menu .m1
list [catch {.m1} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 option ?arg arg ...?"} {}}
-test menu-3.2 {MenuWidgetCmd, Tcl_Preserve and Tcl_Release} {menuInteractive} {
+test menu-3.2 {MenuWidgetCmd, Tcl_Preserve and Tcl_Release} {nonUnixUserInteraction } {
catch {destroy .m1}
menu .m1 -postcommand "destroy .m1"
.m1 add command -label "menu-3.2: Hit Escape"
@@ -551,21 +550,21 @@ test menu-3.4 {MenuWidgetCmd procedure, "activate" option} {
menu .m1
list [catch {.m1 activate "foo"} msg] $msg [destroy .m1]
} {1 {bad menu entry index "foo"} {}}
-test menu-3.5 {MenuWidgetCmd procedure, "activate" option} {
+test menu-3.5 {MenuWidgetCmd procedure, "activate" option} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
.m1 add separator
list [catch {.m1 activate 2} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-3.6 {MenuWidgetCmd procedure, "activate" option} {
+test menu-3.6 {MenuWidgetCmd procedure, "activate" option} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
.m1 entryconfigure 1 -state disabled
list [catch {.m1 activate 1} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-3.7 {MenuWidgetCmd procedure, "activate" option} {
+test menu-3.7 {MenuWidgetCmd procedure, "activate" option} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
@@ -805,7 +804,7 @@ test menu-3.49 {MenuWidgetCmd procedure, "post" option} {
menu .m1
list [catch {.m1 post 40 bar} msg] $msg [destroy .m1]
} {1 {expected integer but got "bar"} {}}
-test menu-3.50 {MenuWidgetCmd procedure, "post" option} {menuInteractive} {
+test menu-3.50 {MenuWidgetCmd procedure, "post" option} {nonUnixUserInteraction } {
catch {destroy .m1}
menu .m1
.m1 add command -label "menu-3.53: hit Escape" -command "puts hello"
@@ -821,7 +820,7 @@ test menu-3.52 {MenuWidgetCmd procedure, "postcascade" option} {
menu .m1
list [catch {.m1 postcascade foo} msg] $msg [destroy .m1]
} {1 {bad menu entry index "foo"} {}}
-test menu-3.53 {MenuWidgetCmd procedure, "postcascade" option} {menuInteractive} {
+test menu-3.53 {MenuWidgetCmd procedure, "postcascade" option} {nonUnixUserInteraction } {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -890,7 +889,7 @@ test menu-3.63 {MenuWidgetCmd procedure, "unpost" option} {
menu .m1
list [catch {.m1 unpost foo} msg] $msg [destroy .m1]
} {1 {wrong # args: should be ".m1 unpost"} {}}
-test menu-3.64 {MenuWidgetCmd procedure, "unpost" option} {menuInteractive} {
+test menu-3.64 {MenuWidgetCmd procedure, "unpost" option} {nonUnixUserInteraction } {
catch {destroy .m1}
menu .m1
.m1 add command -label "menu-3.68 - hit Escape"
@@ -913,19 +912,27 @@ test menu-3.67 {MenuWidgetCmd procedure, bad option} {
list [catch {.m1 foo} msg] $msg [destroy .m1]
} {1 {bad option "foo": must be activate, add, cget, clone, configure, delete, entrycget, entryconfigure, index, insert, invoke, post, postcascade, type, unpost, or yposition} {}}
-test menu-4.1 {TkInvokeMenu} {
+test menu-4.1 {TkInvokeMenu: disabled} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ .m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off \
+ -state disabled
+ list [catch {.m1 invoke 1} msg] [destroy .m1] $foo
+} {0 {} off}
+test menu-4.2 {TkInvokeMenu: tearoff} {
catch {destroy .m1}
menu .m1
list [catch {.m1 invoke 0} msg] [destroy .m1]
} {0 {}}
-test menu-4.2 {TkInvokeMenu} {
+test menu-4.3 {TkInvokeMenu: checkbutton -on} {
catch {destroy .m1}
catch {unset foo}
menu .m1
.m1 add checkbutton -label "test" -variable foo -onvalue on -offvalue off
list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 on 0 {} {}}
-test menu-4.3 {TkInvokeMenu} {
+test menu-4.4 {TkInvokeMenu: checkbutton -off} {
catch {destroy .m1}
catch {unset foo}
menu .m1
@@ -933,7 +940,14 @@ test menu-4.3 {TkInvokeMenu} {
.m1 invoke 1
list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 off 0 {} {}}
-test menu-4.4 {TkInvokeMenu} {
+test menu-4.5 {TkInvokeMenu: checkbutton array element} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ .m1 add checkbutton -label "test" -variable foo(1) -onvalue on
+ list [catch {.m1 invoke 1} msg] $msg [catch {set foo(1)} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
+} {0 {} 0 on 0 {} {}}
+test menu-4.6 {TkInvokeMenu: radiobutton} {
catch {destroy .m1}
catch {unset foo}
menu .m1
@@ -942,7 +956,7 @@ test menu-4.4 {TkInvokeMenu} {
.m1 add radiobutton -label "3" -variable foo -value three
list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 one 0 {} {}}
-test menu-4.5 {TkInvokeMenu} {
+test menu-4.7 {TkInvokeMenu: radiobutton} {
catch {destroy .m1}
catch {unset foo}
menu .m1
@@ -951,7 +965,7 @@ test menu-4.5 {TkInvokeMenu} {
.m1 add radiobutton -label "3" -variable foo -value three
list [catch {.m1 invoke 2} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 two 0 {} {}}
-test menu-4.6 {TkInvokeMenu} {
+test menu-4.8 {TkInvokeMenu: radiobutton} {
catch {destroy .m1}
catch {unset foo}
menu .m1
@@ -960,20 +974,29 @@ test menu-4.6 {TkInvokeMenu} {
.m1 add radiobutton -label "3" -variable foo -value three
list [catch {.m1 invoke 3} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
} {0 {} 0 three 0 {} {}}
-test menu-4.7 {TkInvokeMenu} {
+test menu-4.9 {TkInvokeMenu: radiobutton array element} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ .m1 add radiobutton -label "1" -variable foo(2) -value one
+ .m1 add radiobutton -label "2" -variable foo(2) -value two
+ .m1 add radiobutton -label "3" -variable foo(2) -value three
+ list [catch {.m1 invoke 3} msg] $msg [catch {set foo(2)} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
+} {0 {} 0 three 0 {} {}}
+test menu-4.10 {TkInvokeMenu} {
catch {destroy .m1}
catch {unset menu_test}
menu .m1
.m1 add command -label "test" -command "set menu_test menu-4.8"
list [catch {.m1 invoke 1} msg] $msg [catch {set menu_test} msg2] $msg2 [catch {unset menu_test} msg3] $msg3 [destroy .m1]
} {0 menu-4.8 0 menu-4.8 0 {} {}}
-test menu-4.8 {TkInvokeMenu} {
+test menu-4.11 {TkInvokeMenu} {
catch {destroy .m1}
menu .m1
.m1 add cascade -label "test" -menu .m1.m2
list [catch {.m1 invoke 1} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-4.9 {TkInvokeMenu} {
+test menu-4.12 {TkInvokeMenu} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test" -command ".m1 delete 1"
@@ -1431,44 +1454,60 @@ test menu-9.9 {ConfigureMenu} {
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
-test menu-10.1 {ConfigureMenuEntry} {
+test menu-10.1 {PostProcessEntry: array variable} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ set foo(1) on
+ .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense"
+ list [catch {set foo(1)} msg] $msg [destroy .m1]
+} {0 on {}}
+test menu-10.2 {PostProcessEntry: array variable} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ .m1 add checkbutton -variable foo(1) -onvalue on -offvalue off -label "Nonsense"
+ list [catch {set foo(1)} msg] $msg [destroy .m1]
+} {0 off {}}
+
+test menu-11.1 {ConfigureMenuEntry} {
catch {destroy .m1}
catch {unset foo}
menu .m1
.m1 add checkbutton -variable foo -onvalue on -offvalue off -label "Nonsense"
list [catch {.m1 entryconfigure 1 -variable bar} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
} {0 {} bar {}}
-test menu-10.2 {ConfigureMenuEntry} {
+test menu-11.2 {ConfigureMenuEntry} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
list [catch {.m1 entryconfigure 1 -label ""} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
} {0 {} {} {}}
-test menu-10.3 {ConfigureMenuEntry} {
+test menu-11.3 {ConfigureMenuEntry} {
catch {destroy .m1}
menu .m1
.m1 add command
list [catch {.m1 entryconfigure 1 -label "test"} cmd] $cmd [.m1 entrycget 1 -label] [destroy .m1]
} {0 {} test {}}
-test menu-10.4 {ConfigureMenuEntry} {
+test menu-11.4 {ConfigureMenuEntry} {
catch {destroy .m1}
menu .m1
.m1 add command
list [catch {.m1 entryconfigure 1 -accel "S"} msg] $msg [.m1 entrycget 1 -accel] [destroy .m1]
} {0 {} S {}}
-test menu-10.5 {ConfigureMenuEntry} {
+test menu-11.5 {ConfigureMenuEntry} {
catch {destroy .m1}
menu .m1
.m1 add command
list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
} {0 {} test {}}
-test menu-10.6 {ConfigureMenuEntry} {
+test menu-11.6 {ConfigureMenuEntry} {
catch {destroy .m1}
menu .m1
.m1 add command
list [catch {.m1 entryconfigure 1 -label "test"} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-10.7 {ConfigureMenuEntry} {
+test menu-11.7 {ConfigureMenuEntry} {
catch {destroy .m1}
catch {destroy .m2}
menu .m2
@@ -1476,31 +1515,31 @@ test menu-10.7 {ConfigureMenuEntry} {
.m1 add cascade
list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1 .m2]
} {0 {} {}}
-test menu-10.8 {ConfigureMenuEntry} {
+test menu-11.8 {ConfigureMenuEntry} {
catch {destroy .m1}
menu .m1
.m1 add cascade
list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-10.9 {ConfigureMenuEntry} {
+test menu-11.9 {ConfigureMenuEntry} {
catch {destroy .m1}
menu .m1
.m1 add cascade -menu .m3
list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-10.10 {ConfigureMenuEntry} {
+test menu-11.10 {ConfigureMenuEntry} {
catch {destroy .m1}
menu .m1
.m1 add cascade
list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-10.11 {ConfigureMenuEntry} {
+test menu-11.11 {ConfigureMenuEntry} {
catch {destroy .m1}
menu .m1
.m1 add cascade -menu .m2
list [catch {.m1 entryconfigure 1 -label "test" -menu .m2} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-10.12 {ConfigureMenuEntry} {
+test menu-11.12 {ConfigureMenuEntry} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .m3}
@@ -1517,7 +1556,7 @@ test menu-10.12 {ConfigureMenuEntry} {
.m5 add cascade
list [catch {.m5 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4 .m5]
} {0 {} {}}
-test menu-10.13 {ConfigureMenuEntry} {
+test menu-11.13 {ConfigureMenuEntry} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .m3}
@@ -1531,29 +1570,29 @@ test menu-10.13 {ConfigureMenuEntry} {
.m4 add cascade -menu .m1
list [catch {.m3 entryconfigure 1 -label "test" -menu .m1} msg] $msg [destroy .m1 .m2 .m3 .m4]
} {0 {} {}}
-test menu-10.14 {ConfigureMenuEntry} {
+test menu-11.14 {ConfigureMenuEntry} {
catch {destroy .m1}
menu .m1
.m1 add checkbutton
list [catch {.m1 entryconfigure 1 -variable "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
} {0 {} test {}}
-test menu-10.15 {ConfigureMenuEntry} {
+test menu-11.15 {ConfigureMenuEntry} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add checkbutton -label "test"} msg] $msg [.m1 entrycget 1 -variable] [destroy .m1]
} {0 {} test {}}
-test menu-10.16 {ConfigureMenuEntry} {
+test menu-11.16 {ConfigureMenuEntry} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add radiobutton -label "test"} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-10.17 {ConfigureMenuEntry} {
+test menu-11.17 {ConfigureMenuEntry} {
catch {destroy .m1}
menu .m1
.m1 add checkbutton
list [catch {.m1 entryconfigure 1 -onvalue "test"} msg] $msg [.m1 entrycget 1 -onvalue] [destroy .m1]
} {0 {} test {}}
-test menu-10.18 {ConfigureMenuEntry} {
+test menu-11.18 {ConfigureMenuEntry} {
catch {destroy .m1}
catch {image delete image1}
menu .m1
@@ -1561,7 +1600,7 @@ test menu-10.18 {ConfigureMenuEntry} {
image create test image1
list [catch {.m1 entryconfigure 1 -image image1} msg] $msg [destroy .m1] [image delete image1]
} {0 {} {} {}}
-test menu-10.19 {ConfigureMenuEntry} {
+test menu-11.19 {ConfigureMenuEntry} {
catch {destroy .m1}
catch {image delete image1}
catch {image delete image2}
@@ -1571,7 +1610,7 @@ test menu-10.19 {ConfigureMenuEntry} {
.m1 add command -image image1
list [catch {.m1 entryconfigure 1 -image image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
} {0 {} {} {} {}}
-test menu-10.20 {ConfigureMenuEntry} {
+test menu-11.20 {ConfigureMenuEntry} {
catch {destroy .m1}
catch {image delete image1}
catch {image delete image2}
@@ -1581,7 +1620,7 @@ test menu-10.20 {ConfigureMenuEntry} {
.m1 add checkbutton -image image1
list [catch {.m1 entryconfigure 1 -selectimage image2} msg] $msg [destroy .m1] [image delete image1] [image delete image2]
} {0 {} {} {} {}}
-test menu-10.21 {ConfigureMenuEntry} {
+test menu-11.21 {ConfigureMenuEntry} {
catch {destroy .m1}
catch {image delete image1}
catch {image delete image2}
@@ -1594,7 +1633,7 @@ test menu-10.21 {ConfigureMenuEntry} {
list [catch {.m1 entryconfigure 1 -selectimage image3} msg] $msg [destroy .m1] [image delete image1] [image delete image2] [image delete image3]
} {0 {} {} {} {} {}}
-test menu-11.1 {ConfigureMenuCloneEntries} {
+test menu-12.1 {ConfigureMenuCloneEntries} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .m3}
@@ -1606,7 +1645,7 @@ test menu-11.1 {ConfigureMenuCloneEntries} {
.m1 add command -label "test2"
list [list [catch {.m1 entryconfigure 1 -gork "foo"} msg] $msg] [destroy .m1]
} {{1 {unknown option "-gork"}} {}}
-test menu-11.2 {ConfigureMenuCloneEntries} {
+test menu-12.2 {ConfigureMenuCloneEntries} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .m3}
@@ -1618,7 +1657,7 @@ test menu-11.2 {ConfigureMenuCloneEntries} {
menu .m4
list [catch {.m1 entryconfigure 1 -menu .m4} msg] $msg [destroy .m1] [destroy .m3] [destroy .m4]
} {0 {} {} {} {}}
-test menu-11.3 {ConfigureMenuCloneEntries} {
+test menu-12.3 {ConfigureMenuCloneEntries} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -1627,7 +1666,18 @@ test menu-11.3 {ConfigureMenuCloneEntries} {
list [catch {.m1 entryconfigure dummy -menu .m3} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-12.1 {TkGetMenuIndex} {
+test menu-12.4 {ConfigureMenuCloneEntries} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 add cascade -label File -menu .m1.foo
+ menu .m1.foo
+ .m1.foo add command -label bar
+ .m1 clone .m2
+ list [catch {.m1 entryconfigure File -state disabled} msg1] $msg1 [destroy .m1]
+} {0 {} {}}
+
+test menu-13.1 {TkGetMenuIndex} {
catch {destroy .m1}
menu .m1
.m1 add command -label "active"
@@ -1636,7 +1686,7 @@ test menu-12.1 {TkGetMenuIndex} {
.m1 activate 2
list [catch {.m1 entrycget active -label} msg] $msg [destroy .m1]
} {0 test2 {}}
-test menu-12.2 {TkGetMenuIndex} {
+test menu-13.2 {TkGetMenuIndex} {
catch {destroy .m1}
menu .m1
.m1 add command -label "last"
@@ -1645,7 +1695,7 @@ test menu-12.2 {TkGetMenuIndex} {
.m1 activate 2
list [catch {.m1 entrycget last -label} msg] $msg [destroy .m1]
} {0 test3 {}}
-test menu-12.3 {TkGetMenuIndex} {
+test menu-13.3 {TkGetMenuIndex} {
catch {destroy .m1}
menu .m1
.m1 add command -label "last"
@@ -1654,19 +1704,19 @@ test menu-12.3 {TkGetMenuIndex} {
.m1 activate 2
list [catch {.m1 entrycget end -label} msg] $msg [destroy .m1]
} {0 test3 {}}
-test menu-12.4 {TkGetMenuIndex} {
+test menu-13.4 {TkGetMenuIndex} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
list [catch {.m1 insert last command -label "test2"} msg] $msg [.m1 entrycget last -label] [destroy .m1]
} {0 {} test2 {}}
-test menu-12.5 {TkGetMenuIndex} {
+test menu-13.5 {TkGetMenuIndex} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
list [catch {.m1 insert end command -label "test2"} msg] $msg [.m1 entrycget end -label] [destroy .m1]
} {0 {} test2 {}}
-test menu-12.6 {TkGetMenuIndex} {
+test menu-13.6 {TkGetMenuIndex} {
catch {destroy .m1}
menu .m1
.m1 add command -label "active"
@@ -1676,7 +1726,7 @@ test menu-12.6 {TkGetMenuIndex} {
list [catch {.m1 entrycget none -label} msg] $msg [destroy .m1]
} {0 {} {}}
#test menu-13.7 - Need to add @test here.
-test menu-12.7 {TkGetMenuIndex} {
+test menu-13.7 {TkGetMenuIndex} {
catch {destroy .m1}
menu .m1
.m1 add command -label "active"
@@ -1684,32 +1734,32 @@ test menu-12.7 {TkGetMenuIndex} {
.m1 add command -label "test3"
list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
} {0 active {}}
-test menu-12.8 {TkGetMenuIndex} {
+test menu-13.8 {TkGetMenuIndex} {
catch {destroy .m1}
menu .m1
.m1 add command -label "active"
list [catch {.m1 entrycget -1 -label} msg] $msg [destroy .m1]
} {1 {bad menu entry index "-1"} {}}
-test menu-12.9 {TkGetMenuIndex} {
+test menu-13.9 {TkGetMenuIndex} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
.m1 add command -label "test2"
list [catch {.m1 entrycget 999 -label} msg] $msg [destroy .m1]
} {0 test2 {}}
-test menu-12.10 {TkGetMenuIndex} {
+test menu-13.10 {TkGetMenuIndex} {
catch {destroy .m1}
menu .m1
.m1 insert 999 command -label "test"
list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
} {0 test {}}
-test menu-12.11 {TkGetMenuIndex} {
+test menu-13.11 {TkGetMenuIndex} {
catch {destroy .m1}
menu .m1
.m1 add command -label "1test"
list [catch {.m1 entrycget 1test -label} msg] $msg [destroy .m1]
} {0 1test {}}
-test menu-12.12 {TkGetMenuIndex} {
+test menu-13.12 {TkGetMenuIndex} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
@@ -1718,101 +1768,101 @@ test menu-12.12 {TkGetMenuIndex} {
list [catch {.m1 entrycget test2 -command} msg] $msg [destroy .m1]
} {0 beep {}}
-test menu-13.1 {MenuCmdDeletedProc} {
+test menu-14.1 {MenuCmdDeletedProc} {
catch {destroy .m1}
menu .m1
list [catch {destroy .m1} msg] $msg
} {0 {}}
-test menu-13.2 {MenuCmdDeletedProc} {
+test menu-14.2 {MenuCmdDeletedProc} {
catch {destroy .m1}
menu .m1
.m1 clone .m2
list [catch {destroy .m1} msg] $msg
} {0 {}}
-test menu-14.1 {MenuNewEntry} {
+test menu-15.1 {MenuNewEntry} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-14.2 {MenuNewEntry} {
+test menu-15.2 {MenuNewEntry} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
.m1 add command -label "test3"
list [catch {.m1 insert 2 command -label "test2"} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-14.3 {MenuNewEntry} {
+test menu-15.3 {MenuNewEntry} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
list [catch {.m1 add command -label "test2"} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-14.4 {MenuNewEntry} {
+test menu-15.4 {MenuNewEntry} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add command -label "test"} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-15.1 {MenuAddOrInsert} {
+test menu-16.1 {MenuAddOrInsert} {
catch {destroy .m1}
menu .m1
list [catch {.m1 insert foo command -label "test"} msg] $msg [destroy .m1]
} {1 {bad menu entry index "foo"} {}}
-test menu-15.2 {MenuAddOrInsert} {
+test menu-16.2 {MenuAddOrInsert} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
list [catch {.m1 insert test command -label "foo"} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-15.3 {MenuAddOrInsert} {
+test menu-16.3 {MenuAddOrInsert} {
catch {destroy .m1}
menu .m1
list [catch {.m1 insert -1 command -label "test"} msg] $msg [destroy .m1]
} {1 {bad menu entry index "-1"} {}}
-test menu-15.4 {MenuAddOrInsert} {
+test menu-16.4 {MenuAddOrInsert} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
.m1 insert 0 command -label "test2"
list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
} {0 test2 {}}
-test menu-15.5 {MenuAddOrInsert} {
+test menu-16.5 {MenuAddOrInsert} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add cascade} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-15.6 {MenuAddOrInsert} {
+test menu-16.6 {MenuAddOrInsert} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add checkbutton} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-15.7 {MenuAddOrInsert} {
+test menu-16.7 {MenuAddOrInsert} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add command} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-15.8 {MenuAddOrInsert} {
+test menu-16.8 {MenuAddOrInsert} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add radiobutton} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-15.9 {MenuAddOrInsert} {
+test menu-16.9 {MenuAddOrInsert} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add separator} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-15.10 {MenuAddOrInsert} {
+test menu-16.10 {MenuAddOrInsert} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add blork} msg] $msg [destroy .m1]
} {1 {bad menu entry type "blork": must be cascade, checkbutton, command, radiobutton, or separator} {}}
-test menu-15.11 {MenuAddOrInsert} {
+test menu-16.11 {MenuAddOrInsert} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add command} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-15.12 {MenuAddOrInsert} {
+test menu-16.12 {MenuAddOrInsert} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .m3}
@@ -1821,7 +1871,7 @@ test menu-15.12 {MenuAddOrInsert} {
.m2 clone .m3
list [catch {.m2 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m3 entrycget 1 -label} msg3] $msg3 [destroy .m1]
} {0 {} 0 test 0 test {}}
-test menu-15.13 {MenuAddOrInsert} {
+test menu-16.13 {MenuAddOrInsert} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .m3}
@@ -1830,12 +1880,12 @@ test menu-15.13 {MenuAddOrInsert} {
.m2 clone .m3
list [catch {.m3 add command -label "test"} msg1] $msg1 [catch {.m1 entrycget 1 -label} msg2] $msg2 [catch {.m2 entrycget 1 -label} msg3] $msg3 [destroy .m1]
} {0 {} 0 test 0 test {}}
-test menu-15.14 {MenuAddOrInsert} {
+test menu-16.14 {MenuAddOrInsert} {
catch {destroy .m1}
menu .m1
list [catch {.m1 add command -blork} msg] $msg [destroy .m1]
} {1 {unknown option "-blork"} {}}
-test menu-15.15 {MenuAddOrInsert} {
+test menu-16.15 {MenuAddOrInsert} {
catch {destroy .m1}
catch {destroy .container}
menu .m1
@@ -1844,7 +1894,7 @@ test menu-15.15 {MenuAddOrInsert} {
. configure -menu .container
list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .container .m1]
} {0 {} {} {}}
-test menu-15.16 {MenuAddOrInsert} {
+test menu-16.16 {MenuAddOrInsert} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -1852,7 +1902,7 @@ test menu-15.16 {MenuAddOrInsert} {
set tearoff [tkTearOffMenu .m2]
list [catch {.m2 add cascade -menu .m1} msg] $msg [$tearoff unpost] [catch {destroy .m1} msg2] $msg2 [catch {destroy .m2} msg3] $msg3
} {0 {} {} 0 {} 0 {}}
-test menu-15.17 {MenuAddOrInsert} {
+test menu-16.17 {MenuAddOrInsert} {
catch {destroy .m1}
catch {destroy .container}
menu .m1
@@ -1861,7 +1911,7 @@ test menu-15.17 {MenuAddOrInsert} {
set tearoff [tkTearOffMenu .container]
list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
} {0 {} {} {}}
-test menu-15.18 {MenuAddOrInsert} {
+test menu-16.18 {MenuAddOrInsert} {
catch {destroy .m1}
catch {destroy .container}
menu .m1
@@ -1870,7 +1920,7 @@ test menu-15.18 {MenuAddOrInsert} {
. configure -menu .container
list [catch {.container add cascade -label "File" -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .container]
} {0 {} {} {}}
-test menu-15.19 {MenuAddOrInsert - Insert a cascade deep into the tree} {
+test menu-16.19 {MenuAddOrInsert - Insert a cascade deep into the tree} {
catch {destroy .menubar}
menu .menubar
menu .menubar.test -tearoff 0
@@ -1884,7 +1934,7 @@ test menu-15.19 {MenuAddOrInsert - Insert a cascade deep into the tree} {
[. configure -menu ""] [destroy .menubar]
} {0 .#menubar.#menubar#test.#menubar#test#cascade {} {}}
-test menu-16.1 {MenuVarProc} {
+test menu-17.1 {MenuVarProc} {
catch {destroy .m1}
catch {unset foo}
menu .m1
@@ -1892,45 +1942,45 @@ test menu-16.1 {MenuVarProc} {
list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [catch {unset foo} msg2] $msg2 [destroy .m1]
} {0 {} 0 {} {}}
# menu-17.2 - Don't know how to generate the flags in the if
-test menu-16.2 {MenuVarProc} {
+test menu-17.2 {MenuVarProc} {
catch {destroy .m1}
catch {unset foo}
menu .m1
list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo ""] [destroy .m1]
} {0 {} {} {}}
-test menu-16.3 {MenuVarProc} {
+test menu-17.3 {MenuVarProc} {
catch {destroy .m1}
catch {unset foo}
menu .m1
set foo "hello"
list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2
} {0 {} hello {} 0 {}}
-test menu-16.4 {MenuVarProc} {
+test menu-17.4 {MenuVarProc} {
catch {destroy .m1}
menu .m1
set foo "goodbye"
list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "hello"] [destroy .m1] [catch {unset foo} msg2] $msg2
} {0 {} hello {} 0 {}}
-test menu-16.5 {MenuVarProc} {
+test menu-17.5 {MenuVarProc} {
catch {destroy .m1}
menu .m1
set foo "hello"
list [catch {.m1 add checkbutton -variable foo -onvalue hello -offvalue goodbye} msg] $msg [set foo "goodbye"] [destroy .m1] [catch {unset foo} msg2] $msg2
} {0 {} goodbye {} 0 {}}
-test menu-17.1 {TkActivateMenuEntry} {
+test menu-18.1 {TkActivateMenuEntry} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
list [catch {.m1 activate 1} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-17.2 {TkActivateMenuEntry} {
+test menu-18.2 {TkActivateMenuEntry} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
list [catch {.m1 activate 0} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-17.3 {TkActivateMenuEntry} {
+test menu-18.3 {TkActivateMenuEntry} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
@@ -1938,7 +1988,7 @@ test menu-17.3 {TkActivateMenuEntry} {
.m1 activate 1
list [catch {.m1 activate 2} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-17.4 {TkActivateMenuEntry} {
+test menu-18.4 {TkActivateMenuEntry} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
@@ -1947,56 +1997,56 @@ test menu-17.4 {TkActivateMenuEntry} {
list [catch {.m1 activate 1} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-18.1 {TkPostCommand} {menuInteractive} {
+test menu-19.1 {TkPostCommand} {nonUnixUserInteraction } {
catch {destroy .m1}
menu .m1 -postcommand "set menu_test menu-19.1"
.m1 add command -label "menu-19.1 - hit Escape"
list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [set menu_test] [destroy .m1]
} {0 menu-19.1 {} menu-19.1 {}}
-test menu-18.2 {TkPostCommand} {menuInteractive} {
+test menu-19.2 {TkPostCommand} {nonUnixUserInteraction } {
catch {destroy .m1}
menu .m1
.m1 add command -label "menu-19.2 - hit Escape"
list [catch {.m1 post 40 40} msg] $msg [.m1 unpost] [destroy .m1]
} {0 {} {} {}}
-test menu-19.1 {CloneMenu} {
+test menu-20.1 {CloneMenu} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
list [catch {.m1 clone .m2} msg1] $msg1 [destroy .m1]
} {0 {} {}}
-test menu-19.2 {CloneMenu} {
+test menu-20.2 {CloneMenu} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
list [catch {.m1 clone .m2 normal} msg1] $msg1 [destroy .m1]
} {0 {} {}}
-test menu-19.3 {CloneMenu} {
+test menu-20.3 {CloneMenu} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
list [catch {.m1 clone .m2 tearoff} msg1] $msg1 [destroy .m1]
} {0 {} {}}
-test menu-19.4 {CloneMenu} {
+test menu-20.4 {CloneMenu} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
list [catch {.m1 clone .m2 menubar} msg1] $msg1 [destroy .m1]
} {0 {} {}}
-test menu-19.5 {CloneMenu} {
+test menu-20.5 {CloneMenu} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
list [catch {.m1 clone .m2 foo} msg1] $msg1 [destroy .m1]
-} {1 {bad menu type - must be normal, tearoff, or menubar} {}}
-test menu-19.6 {CloneMenu - hooking up bookeeping ptrs} {
+} {1 {bad menu type "foo": must be normal, tearoff, or menubar} {}}
+test menu-20.6 {CloneMenu - hooking up bookeeping ptrs} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
list [catch {.m1 clone .m2} msg] $msg [destroy .m1]
} {0 {} {}}
- test menu-19.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} {
+ test menu-20.7 {CloneMenu - hooking up bookeeping ptrs - multiple children} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .m3}
@@ -2004,14 +2054,14 @@ test menu-19.6 {CloneMenu - hooking up bookeeping ptrs} {
.m1 clone .m2
list [catch {.m1 clone .m3} msg] $msg [destroy .m1]
} {0 {} {}}
- test menu-19.8 {CloneMenu - cascade entries} {
+ test menu-20.8 {CloneMenu - cascade entries} {
catch {destroy .m1}
catch {destroy .foo}
menu .m1
.m1 add cascade -menu .m2
list [catch {.m1 clone .foo} msg] $msg [destroy .m1]
} {0 {} {}}
- test menu-19.9 {CloneMenu - cascades entries} {
+ test menu-20.9 {CloneMenu - cascades entries} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .foo}
@@ -2020,13 +2070,13 @@ test menu-19.6 {CloneMenu - hooking up bookeeping ptrs} {
menu .m2
list [catch {.m1 clone .foo} msg] $msg [destroy .m1 .m2]
} {0 {} {}}
-test menu-19.10 {CloneMenu - tearoff fields} {
+test menu-20.10 {CloneMenu - tearoff fields} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
list [catch {.m1 clone .m2 normal} msg1] $msg1 [catch {.m2 cget -tearoff} msg2] $msg2 [destroy .m1]
} {0 {} 0 1 {}}
-test menu-19.11 {CloneMenu} {
+test menu-20.11 {CloneMenu} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -2034,26 +2084,26 @@ test menu-19.11 {CloneMenu} {
list [catch {.m1 clone .m2} msg] $msg [destroy .m1 .m2]
} {1 {window name "m2" already exists in parent} {}}
-test menu-20.1 {MenuDoYPosition} {
+test menu-21.1 {MenuDoYPosition} {
catch {destroy .m1}
menu .m1
list [catch {.m1 yposition glorp} msg] $msg [destroy .m1]
} {1 {bad menu entry index "glorp"} {}}
-test menu-20.2 {MenuDoYPosition} {
+test menu-21.2 {MenuDoYPosition} {
catch {destroy .m1}
menu .m1
.m1 add command -label "Test"
list [catch {.m1 yposition 1}] [destroy .m1]
} {0 {}}
-test menu-21.1 {GetIndexFromCoords} {
+test menu-22.1 {GetIndexFromCoords} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
.m1 configure -tearoff 0
list [catch {.m1 index @5} msg] $msg [destroy .m1]
} {0 0 {}}
-test menu-21.2 {GetIndexFromCoords} {
+test menu-22.2 {GetIndexFromCoords} {
catch {destroy .m1}
menu .m1
.m1 add command -label "test"
@@ -2061,13 +2111,13 @@ test menu-21.2 {GetIndexFromCoords} {
list [catch {.m1 index @5,5} msg] $msg [destroy .m1]
} {0 0 {}}
-test menu-22.1 {RecursivelyDeleteMenu} {
+test menu-23.1 {RecursivelyDeleteMenu} {
catch {destroy .m1}
menu .m1
. configure -menu .m1
list [catch {. configure -menu ""} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-22.2 {RecursivelyDeleteMenu} {
+test menu-23.2 {RecursivelyDeleteMenu} {
catch {destroy .m1}
catch {destroy .m2}
menu .m2
@@ -2078,40 +2128,40 @@ test menu-22.2 {RecursivelyDeleteMenu} {
list [catch {. configure -menu ""} msg] $msg [destroy .m1 .m2]
} {0 {} {}}
-test menu-23.1 {TkNewMenuName} {
+test menu-24.1 {TkNewMenuName} {
catch {destroy .m1}
menu .m1
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
-test menu-23.2 {TkNewMenuName} {
+test menu-24.2 {TkNewMenuName} {
catch {destroy .m1}
catch {destroy .m1\#0}
menu .m1
menu .m1\#0
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
-test menu-23.3 {TkNewMenuName} {
+test menu-24.3 {TkNewMenuName} {
catch {destroy .#m}
menu .#m
rename .#m hideme
list [catch {. configure -menu [menu .m]} $msg] [. configure -menu ""] [destroy .#m] [destroy .m] [destroy hideme]
} {0 {} {} {} {}}
-test menu-24.1 {TkSetWindowMenuBar} {
+test menu-25.1 {TkSetWindowMenuBar} {
. configure -menu ""
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
} {0 {} {}}
-test menu-24.2 {TkSetWindowMenuBar} {
+test menu-25.2 {TkSetWindowMenuBar} {
. configure -menu ""
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
} {0 {} {}}
-test menu-24.3 {TkSetWindowMenuBar} {
+test menu-25.3 {TkSetWindowMenuBar} {
. configure -menu ""
catch {destroy .m1}
menu .m1
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
-test menu-24.4 {TkSetWindowMenuBar} {
+test menu-25.4 {TkSetWindowMenuBar} {
catch {destroy .m1}
catch {destroy .m2}
. configure -menu ""
@@ -2120,7 +2170,7 @@ test menu-24.4 {TkSetWindowMenuBar} {
menu .m2
list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
} {0 {} {} {}}
-test menu-24.5 {TkSetWindowMenuBar} {
+test menu-25.5 {TkSetWindowMenuBar} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .m3}
@@ -2131,7 +2181,7 @@ test menu-24.5 {TkSetWindowMenuBar} {
menu .m3
list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
} {0 {} {} {}}
-test menu-24.6 {TkSetWindowMenuBar} {
+test menu-25.6 {TkSetWindowMenuBar} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .m3}
@@ -2142,7 +2192,7 @@ test menu-24.6 {TkSetWindowMenuBar} {
menu .m3
list [catch {. configure -menu .m3} msg] $msg [. configure -menu ""] [destroy .m1 .m3]
} {0 {} {} {}}
-test menu-24.7 {TkSetWindowMenuBar} {
+test menu-25.7 {TkSetWindowMenuBar} {
catch {destroy .m1}
catch {destroy .m2}
. configure -menu ""
@@ -2153,7 +2203,7 @@ test menu-24.7 {TkSetWindowMenuBar} {
.t2 configure -menu .m1
list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
} {0 {} {} {}}
-test menu-24.8 {TkSetWindowMenuBar} {
+test menu-25.8 {TkSetWindowMenuBar} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .t2}
@@ -2166,7 +2216,7 @@ test menu-24.8 {TkSetWindowMenuBar} {
.t2 configure -menu .m1
list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1 .m2]
} {0 {} {} {}}
-test menu-24.9 {TkSetWindowMenuBar} {
+test menu-25.9 {TkSetWindowMenuBar} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .t2}
@@ -2181,7 +2231,7 @@ test menu-24.9 {TkSetWindowMenuBar} {
wm geometry .t3 +0+0
list [catch {.t3 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
} {0 {} {} {}}
-test menu-24.10 {TkSetWindowMenuBar} {
+test menu-25.10 {TkSetWindowMenuBar} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .t2}
@@ -2196,7 +2246,7 @@ test menu-24.10 {TkSetWindowMenuBar} {
wm geometry .t3 +0+0
list [catch {.t2 configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
} {0 {} {} {}}
-test menu-24.11 {TkSetWindowMenuBar} {
+test menu-25.11 {TkSetWindowMenuBar} {
catch {destroy .m1}
catch {destroy .m2}
catch {destroy .t2}
@@ -2211,27 +2261,27 @@ test menu-24.11 {TkSetWindowMenuBar} {
wm geometry .t3 +0+0
list [catch {. configure -menu .m2} msg] $msg [. configure -menu ""] [destroy .t2 .t3 .m1 .m2]
} {0 {} {} {}}
-test menu-24.12 {TkSetWindowMenuBar} {
+test menu-25.12 {TkSetWindowMenuBar} {
catch {destroy .m1}
. configure -menu ""
menu .m1
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
-test menu-24.13 {TkSetWindowMenuBar} {
+test menu-25.13 {TkSetWindowMenuBar} {
. configure -menu ""
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
} {0 {} {}}
-test menu-24.14 {TkSetWindowMenuBar} {
+test menu-25.14 {TkSetWindowMenuBar} {
catch {destroy .m1}
. configure -menu ""
menu .m1
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
-test menu-24.15 {TkSetWindowMenuBar} {
+test menu-25.15 {TkSetWindowMenuBar} {
. configure -menu ""
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""]
} {0 {} {}}
-test menu-24.16 {TkSetWindowMenuBar} {
+test menu-25.16 {TkSetWindowMenuBar} {
catch {destroy .m1}
. configure -menu ""
menu .m1
@@ -2239,7 +2289,7 @@ test menu-24.16 {TkSetWindowMenuBar} {
list [catch {toplevel .t2 -menu m1} msg] $msg [. configure -menu ""] [destroy .t2 .m1]
} {0 .t2 {} {}}
-test menu-25.1 {DestroyMenuHashTable} {
+test menu-26.1 {DestroyMenuHashTable} {
catch {interp destroy testinterp}
interp create testinterp
load {} Tk testinterp
@@ -2247,18 +2297,18 @@ test menu-25.1 {DestroyMenuHashTable} {
list [catch {interp delete testinterp} msg] $msg
} {0 {}}
-test menu-26.1 {GetMenuHashTable} {
+test menu-27.1 {GetMenuHashTable} {
catch {interp destroy testinterp}
interp create testinterp
load {} tk testinterp
list [catch {interp eval testinterp {menu .m1}} msg] $msg [interp delete testinterp]
} {0 .m1 {}}
-test menu-27.1 {TkCreateMenuReferences - not there before} {
+test menu-28.1 {TkCreateMenuReferences - not there before} {
catch {destroy .m1}
list [catch {menu .m1} msg] $msg [destroy .m1]
} {0 .m1 {}}
-test menu-27.2 {TkCreateMenuReferences - there already} {
+test menu-28.2 {TkCreateMenuReferences - there already} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -2266,14 +2316,14 @@ test menu-27.2 {TkCreateMenuReferences - there already} {
list [catch {menu .m2} msg] $msg [destroy .m1 .m2]
} {0 .m2 {}}
-test menu-28.1 {TkFindMenuReferences - not there} {
+test menu-29.1 {TkFindMenuReferences - not there} {
catch {destroy .m1}
. configure -menu ""
menu .m1
.m1 add cascade -menu .m2
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
} {0 {} {} {}}
-test menu-29.1 {TkFindMenuReferences - there already} {
+test menu-30.1 {TkFindMenuReferences - there already} {
catch {destroy .m1}
catch {destroy .m2}
. configure -menu ""
@@ -2283,23 +2333,23 @@ test menu-29.1 {TkFindMenuReferences - there already} {
list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1 .m2]
} {0 {} {} {}}
-test menu-30.1 {TkFreeMenuReferences - menuPtr} {
+test menu-31.1 {TkFreeMenuReferences - menuPtr} {
catch {destroy .m1}
menu .m1
list [catch {destroy .m1} msg] $msg
} {0 {}}
-test menu-30.2 {TkFreeMenuReferences - cascadePtr} {
+test menu-31.2 {TkFreeMenuReferences - cascadePtr} {
catch {destroy .m1}
. configure -menu ""
menu .m1
.m1 add cascade -menu .m2
list [catch {.m1 entryconfigure 1 -menu .m3} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-30.3 {TkFreeMenuReferences - topLevelListPtr} {
+test menu-31.3 {TkFreeMenuReferences - topLevelListPtr} {
. configure -menu .m1
list [catch {. configure -menu ""} msg] $msg
} {0 {}}
-test menu-30.4 {TkFreeMenuReferences - not empty} {
+test menu-31.4 {TkFreeMenuReferences - not empty} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -2309,7 +2359,7 @@ test menu-30.4 {TkFreeMenuReferences - not empty} {
list [catch {.m2 entryconfigure 1 -menu ".foo"} msg] $msg [destroy .m1 .m2]
} {0 {} {}}
-test menu-31.1 {DeleteMenuCloneEntries} {
+test menu-32.1 {DeleteMenuCloneEntries} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -2317,7 +2367,7 @@ test menu-31.1 {DeleteMenuCloneEntries} {
.m1 clone .m2
list [catch {.m1 delete 1} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-31.2 {DeleteMenuCloneEntries} {
+test menu-32.2 {DeleteMenuCloneEntries} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -2328,7 +2378,7 @@ test menu-31.2 {DeleteMenuCloneEntries} {
.m1 clone .m2
list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-31.3 {DeleteMenuCloneEntries} {
+test menu-32.3 {DeleteMenuCloneEntries} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1 -tearoff 0
@@ -2340,7 +2390,7 @@ test menu-31.3 {DeleteMenuCloneEntries} {
.m2 configure -tearoff 1
list [catch {.m1 delete 1 2} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-31.4 {DeleteMenuCloneEntries} {
+test menu-32.4 {DeleteMenuCloneEntries} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -2352,7 +2402,7 @@ test menu-31.4 {DeleteMenuCloneEntries} {
.m2 configure -tearoff 0
list [catch {.m1 delete 2 3} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-31.5 {DeleteMenuCloneEntries} {
+test menu-32.5 {DeleteMenuCloneEntries} {
catch {destroy .m1}
catch {destroy .m2}
menu .m1
@@ -2362,17 +2412,23 @@ test menu-31.5 {DeleteMenuCloneEntries} {
.m1 activate one
list [catch {.m1 delete one} msg] $msg [destroy .m1]
} {0 {} {}}
-test menu-31.6 {DeleteMenuCloneEntries - reentrancy - crashes tk8.0} {
+test menu-32.6 {DeleteMenuCloneEntries - reentrancy - crashes tk8.0} {
catch {destroy .m1}
menu .m1
.m1 add command -label test -command ".m1 delete test ; .m1 add command -label test -command \".m1 delete test\"; .m1 delete test"
list [catch {.m1 invoke test} msg] $msg [destroy .m1]
} {0 {} {}}
+test menu-32.7 {DeleteMenuCloneEntries - one entry} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label Hello
+ list [catch {.m1 delete Hello} msg] $msg [destroy .m1]
+} {0 {} {}}
set l [interp hidden]
eval destroy [winfo children .]
-test menu-32.1 {menu vs command hiding} {
+test menu-33.1 {menu vs command hiding} {
catch {destroy .m}
menu .m
interp hide {} .m
@@ -2382,4 +2438,20 @@ test menu-32.1 {menu vs command hiding} {
# menu-34 MenuInit only called at boot time
+# cleanup
deleteWindows
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+