diff options
Diffstat (limited to 'tests/menu.test')
| -rw-r--r-- | tests/menu.test | 500 |
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 + + + + + + + + + + + + + |