diff options
Diffstat (limited to 'tk/tests/unixWm.test')
| -rw-r--r-- | tk/tests/unixWm.test | 404 |
1 files changed, 176 insertions, 228 deletions
diff --git a/tk/tests/unixWm.test b/tk/tests/unixWm.test index 78cb9e4b058..08e5660f63e 100644 --- a/tk/tests/unixWm.test +++ b/tk/tests/unixWm.test @@ -9,15 +9,16 @@ # # RCS: @(#) $Id$ -if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] -} +package require tcltest 2.2 +namespace import -force tcltest::configure +namespace import -force tcltest::testsDirectory +configure -testdir [file join [pwd] [file dirname [info script]]] +configure -loadfile [file join [testsDirectory] constraints.tcl] +tcltest::loadTestedCommands -if {$tcl_platform(platform) != "unix"} { - puts "skipping: Unix only tests..." - ::tcltest::cleanupTests - return -} +namespace import -force tcltest::interpreter +namespace import -force tcltest::makeFile +namespace import -force tcltest::removeFile proc sleep ms { global x @@ -28,9 +29,7 @@ proc sleep ms { # Procedure to set up a collection of top-level windows proc makeToplevels {} { - foreach i [winfo child .] { - destroy $i - } + deleteWindows foreach i {.raise1 .raise2 .raise3} { toplevel $i wm geom $i 150x100+0+0 @@ -41,7 +40,7 @@ proc makeToplevels {} { set i 1 foreach geom {+20+80 +80+20 +0+0} { catch {destroy .t} - test unixWm-1.$i {initial window position} { + test unixWm-1.$i {initial window position} unix { toplevel .t -width 200 -height 150 wm geom .t $geom update @@ -66,7 +65,7 @@ scan [wm geom .t] %dx%d+%d+%d width height x y set xerr [expr 150-$x] set yerr [expr 150-$y] foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} { - test unixWm-2.$i {moving window while mapped} { + test unixWm-2.$i {moving window while mapped} unix { wm geom .t $geom update scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y @@ -78,7 +77,7 @@ foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} { set i 1 foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} { - test unixWm-3.$i {moving window while iconified} { + test unixWm-3.$i {moving window while iconified} unix { wm iconify .t sleep 200 wm geom .t $geom @@ -93,7 +92,7 @@ foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} { set i 1 foreach geom {+20+80 +100+40 +0+0} { - test unixWm-4.$i {moving window while withdrawn} { + test unixWm-4.$i {moving window while withdrawn} unix { wm withdraw .t sleep 200 wm geom .t $geom @@ -104,7 +103,7 @@ foreach geom {+20+80 +100+40 +0+0} { incr i } -test unixWm-5.1 {compounded state changes} {nonPortable} { +test unixWm-5.1 {compounded state changes} {unix nonPortable} { catch {destroy .t} toplevel .t -width 200 -height 100 wm geometry .t +100+100 @@ -113,7 +112,7 @@ test unixWm-5.1 {compounded state changes} {nonPortable} { wm deiconify .t list [winfo ismapped .t] [wm state .t] } {1 normal} -test unixWm-5.2 {compounded state changes} {nonPortable} { +test unixWm-5.2 {compounded state changes} {unix nonPortable} { catch {destroy .t} toplevel .t -width 200 -height 100 wm geometry .t +100+100 @@ -123,7 +122,7 @@ test unixWm-5.2 {compounded state changes} {nonPortable} { wm withdraw .t list [winfo ismapped .t] [wm state .t] } {0 withdrawn} -test unixWm-5.3 {compounded state changes} {nonPortable} { +test unixWm-5.3 {compounded state changes} {unix nonPortable} { catch {destroy .t} toplevel .t -width 200 -height 100 wm geometry .t +100+100 @@ -134,7 +133,7 @@ test unixWm-5.3 {compounded state changes} {nonPortable} { wm deiconify .t list [winfo ismapped .t] [wm state .t] } {1 normal} -test unixWm-5.4 {compounded state changes} {nonPortable} { +test unixWm-5.4 {compounded state changes} {unix nonPortable} { catch {destroy .t} toplevel .t -width 200 -height 100 wm geometry .t +100+100 @@ -144,7 +143,7 @@ test unixWm-5.4 {compounded state changes} {nonPortable} { wm iconify .t list [winfo ismapped .t] [wm state .t] } {0 iconic} -test unixWm-5.5 {compounded state changes} {nonPortable} { +test unixWm-5.5 {compounded state changes} {unix nonPortable} { catch {destroy .t} toplevel .t -width 200 -height 100 wm geometry .t +100+100 @@ -153,7 +152,7 @@ test unixWm-5.5 {compounded state changes} {nonPortable} { wm withdraw .t list [winfo ismapped .t] [wm state .t] } {0 withdrawn} -test unixWm-5.6 {compounded state changes} {nonPortable} { +test unixWm-5.6 {compounded state changes} {unix nonPortable} { catch {destroy .t} toplevel .t -width 200 -height 100 wm geometry .t +100+100 @@ -163,7 +162,7 @@ test unixWm-5.6 {compounded state changes} {nonPortable} { wm deiconify .t list [winfo ismapped .t] [wm state .t] } {1 normal} -test unixWm-5.7 {compounded state changes} {nonPortable} { +test unixWm-5.7 {compounded state changes} {unix nonPortable} { catch {destroy .t} toplevel .t -width 200 -height 100 wm geometry .t +100+100 @@ -178,25 +177,25 @@ toplevel .t -width 200 -height 100 wm geom .t +10+10 wm minsize .t 1 1 update -test unixWm-6.1 {size changes} { +test unixWm-6.1 {size changes} unix { .t config -width 180 -height 150 update wm geom .t } 180x150+10+10 -test unixWm-6.2 {size changes} { +test unixWm-6.2 {size changes} unix { wm geom .t 250x60 .t config -width 170 -height 140 update wm geom .t } 250x60+10+10 -test unixWm-6.3 {size changes} { +test unixWm-6.3 {size changes} unix { wm geom .t 250x60 .t config -width 170 -height 140 wm geom .t {} update wm geom .t } 170x140+10+10 -test unixWm-6.4 {size changes} {nonPortable userInteraction} { +test unixWm-6.4 {size changes} {unix nonPortable userInteraction} { wm minsize .t 1 1 update puts stdout "Please resize window \"t\" with the mouse (but don't move it!)," @@ -223,7 +222,7 @@ test unixWm-6.4 {size changes} {nonPortable userInteraction} { # fails under twm. sleep 200 -test unixWm-6.5 {window initially iconic} {nonPortable} { +test unixWm-6.5 {window initially iconic} {unix nonPortable} { catch {destroy .t} toplevel .t -width 100 -height 30 wm geometry .t +0+0 @@ -243,22 +242,22 @@ foreach i {{Test label} Another {Yet another} {Last label}} j {1 2 3} { } wm geometry .m +[expr 100 - [winfo vrootx .]]+[expr 200 - [winfo vrooty .]] update -test unixWm-7.1 {override_redirect and Tk_MoveTopLevelWindow} { +test unixWm-7.1 {override_redirect and Tk_MoveTopLevelWindow} unix { list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m] } {1 normal 100 200} wm geometry .m +[expr 150 - [winfo vrootx .]]+[expr 210 - [winfo vrooty .]] update -test unixWm-7.2 {override_redirect and Tk_MoveTopLevelWindow} { +test unixWm-7.2 {override_redirect and Tk_MoveTopLevelWindow} unix { list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m] } {1 normal 150 210} wm withdraw .m -test unixWm-7.3 {override_redirect and Tk_MoveTopLevelWindow} { +test unixWm-7.3 {override_redirect and Tk_MoveTopLevelWindow} unix { list [winfo ismapped .m] } 0 destroy .m catch {destroy .t} -test unixWm-8.1 {icon windows} { +test unixWm-8.1 {icon windows} unix { catch {destroy .t} catch {destroy .icon} toplevel .t -width 100 -height 30 @@ -267,17 +266,17 @@ test unixWm-8.1 {icon windows} { wm iconwindow .t .icon list [catch {wm withdraw .icon} msg] $msg } {1 {can't withdraw .icon: it is an icon for .t}} -test unixWm-8.2 {icon windows} { +test unixWm-8.2 {icon windows} unix { catch {destroy .t} toplevel .t -width 100 -height 30 list [catch {wm iconwindow} msg] $msg } {1 {wrong # args: should be "wm option window ?arg ...?"}} -test unixWm-8.3 {icon windows} { +test unixWm-8.3 {icon windows} unix { catch {destroy .t} toplevel .t -width 100 -height 30 list [catch {wm iconwindow .t b c} msg] $msg -} {1 {wrong # arguments: must be "wm iconwindow window ?pathName?"}} -test unixWm-8.4 {icon windows} { +} {1 {wrong # args: should be "wm iconwindow window ?pathName?"}} +test unixWm-8.4 {icon windows} unix { catch {destroy .t} catch {destroy .icon} toplevel .t -width 100 -height 30 @@ -294,18 +293,18 @@ test unixWm-8.4 {icon windows} { update lappend result [winfo ismapped .t] [winfo ismapped .icon] } {.icon icon {} withdrawn 1 0 0 0} -test unixWm-8.5 {icon windows} { +test unixWm-8.5 {icon windows} unix { catch {destroy .t} toplevel .t -width 100 -height 30 list [catch {wm iconwindow .t .gorp} msg] $msg } {1 {bad window path name ".gorp"}} -test unixWm-8.6 {icon windows} { +test unixWm-8.6 {icon windows} unix { catch {destroy .t} toplevel .t -width 100 -height 30 frame .t.icon -width 50 -height 50 -bg red list [catch {wm iconwindow .t .t.icon} msg] $msg } {1 {can't use .t.icon as icon window: not at top level}} -test unixWm-8.7 {icon windows} { +test unixWm-8.7 {icon windows} unix { catch {destroy .t} catch {destroy .icon} toplevel .t -width 100 -height 30 @@ -318,7 +317,7 @@ test unixWm-8.7 {icon windows} { lappend result [wm iconwindow .t] [wm state .icon] [wm state .icon2] } {.icon icon normal .icon2 withdrawn icon} catch {destroy .icon2} -test unixWm-8.8 {icon windows} { +test unixWm-8.8 {icon windows} unix { catch {destroy .t} catch {destroy .icon} toplevel .icon -width 50 -height 50 -bg red @@ -332,7 +331,7 @@ test unixWm-8.8 {icon windows} { sleep 500 lappend result [winfo ismapped .t] [winfo ismapped .icon] } {1 1 0} -test unixWm-8.9 {icon windows} {nonPortable} { +test unixWm-8.9 {icon windows} {unix nonPortable} { # This test is non-portable because some window managers will # destroy an icon window when it's associated window is destroyed. @@ -353,7 +352,7 @@ test unixWm-8.9 {icon windows} {nonPortable} { lappend result [winfo ismapped .icon] [wm state .icon] } {icon 1 0 0 withdrawn 1 normal} -test unixWm-59.1 {test for memory leaks} { +test unixWm-8.10.1 {test for memory leaks} unix { wm title .t "This is a long long long long long long title" wm title .t "This is a long long long long long long title" wm title .t "This is a long long long long long long title" @@ -364,7 +363,7 @@ test unixWm-59.1 {test for memory leaks} { wm title .t "This is a long long long long long long title" set x 1 } 1 -test unixWm-59.2 {test for memory leaks} { +test unixWm-8.10.2 {test for memory leaks} unix { wm group .t . wm group .t . wm group .t . @@ -378,14 +377,7 @@ test unixWm-59.2 {test for memory leaks} { set x 1 } 1 -if {[string compare testwrapper [info commands testwrapper]] != 0} { - puts "This application hasn't been compiled with the testwrapper command," - puts "therefore I am skipping all of these tests." - ::tcltest::cleanupTests - return -} - -test unixWm-9.1 {TkWmMapWindow procedure, client property} {unixOnly} { +test unixWm-9.1 {TkWmMapWindow procedure, client property} {unix testwrapper} { catch {destroy .t} toplevel .t -width 100 -height 50 wm geom .t +0+0 @@ -393,7 +385,7 @@ test unixWm-9.1 {TkWmMapWindow procedure, client property} {unixOnly} { update testprop [testwrapper .t] WM_CLIENT_MACHINE } {Test_String} -test unixWm-9.2 {TkWmMapWindow procedure, command property} {unixOnly} { +test unixWm-9.2 {TkWmMapWindow procedure, command property} {unix testwrapper} { catch {destroy .t} toplevel .t -width 100 -height 50 wm geom .t +0+0 @@ -427,6 +419,8 @@ test unixWm-9.5 {TkWmMapWindow procedure, normal windows} { winfo ismapped .t } {1} +testConstraint testmenubar [llength [info commands testmenubar]] + test unixWm-10.1 {TkWmDeadWindow procedure, canceling UpdateGeometry idle handler} { catch {destroy .t} toplevel .t -width 100 -height 50 @@ -435,7 +429,7 @@ test unixWm-10.1 {TkWmDeadWindow procedure, canceling UpdateGeometry idle handle .t configure -width 200 -height 100 destroy .t } {} -test unixWm-10.2 {TkWmDeadWindow procedure, destroying menubar} {unixOnly} { +test unixWm-10.2 {TkWmDeadWindow procedure, destroying menubar} {unix testmenubar} { catch {destroy .t} catch {destroy .f} toplevel .t -width 300 -height 200 -bd 2 -relief raised @@ -454,10 +448,10 @@ test unixWm-11.1 {Tk_WmCmd procedure, miscellaneous errors} { list [catch {wm} msg] $msg } {1 {wrong # args: should be "wm option window ?arg ...?"}} test unixWm-11.2 {Tk_WmCmd procedure, miscellaneous errors} { - list [catch {wm foo} msg] $msg + list [catch {wm aspect} msg] $msg } {1 {wrong # args: should be "wm option window ?arg ...?"}} test unixWm-11.3 {Tk_WmCmd procedure, miscellaneous errors} { - list [catch {wm foo bogus} msg] $msg + list [catch {wm iconify bogus} msg] $msg } {1 {bad window path name "bogus"}} test unixWm-11.4 {Tk_WmCmd procedure, miscellaneous errors} { catch {destroy .b} @@ -474,10 +468,10 @@ update test unixWm-12.1 {Tk_WmCmd procedure, "aspect" option} { list [catch {wm aspect .t 12} msg] $msg -} {1 {wrong # arguments: must be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}} +} {1 {wrong # args: should be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}} test unixWm-12.2 {Tk_WmCmd procedure, "aspect" option} { list [catch {wm aspect .t 12 13 14 15 16} msg] $msg -} {1 {wrong # arguments: must be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}} +} {1 {wrong # args: should be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}} test unixWm-12.3 {Tk_WmCmd procedure, "aspect" option} { set result {} lappend result [wm aspect .t] @@ -513,8 +507,8 @@ test unixWm-12.11 {Tk_WmCmd procedure, "aspect" option} { test unixWm-13.1 {Tk_WmCmd procedure, "client" option} { list [catch {wm client .t x y} msg] $msg -} {1 {wrong # arguments: must be "wm client window ?name?"}} -test unixWm-13.2 {Tk_WmCmd procedure, "client" option} {unixOnly} { +} {1 {wrong # args: should be "wm client window ?name?"}} +test unixWm-13.2 {Tk_WmCmd procedure, "client" option} {unix testwrapper} { set result {} lappend result [wm client .t] wm client .t Test_String @@ -535,7 +529,7 @@ test unixWm-13.3 {Tk_WmCmd procedure, "client" option, unmapped window} { test unixWm-14.1 {Tk_WmCmd procedure, "colormapwindows" option} { list [catch {wm colormapwindows .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm colormapwindows window ?windowList?"}} +} {1 {wrong # args: should be "wm colormapwindows window ?windowList?"}} test unixWm-14.2 {Tk_WmCmd procedure, "colormapwindows" option} { catch {destroy .t2} toplevel .t2 -width 200 -height 200 -colormap new @@ -590,11 +584,11 @@ catch {destroy .t2} test unixWm-15.1 {Tk_WmCmd procedure, "command" option} { list [catch {wm command .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm command window ?value?"}} +} {1 {wrong # args: should be "wm command window ?value?"}} test unixWm-15.2 {Tk_WmCmd procedure, "command" option} { list [catch {wm command .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm command window ?value?"}} -test unixWm-15.3 {Tk_WmCmd procedure, "command" option} {unixOnly} { +} {1 {wrong # args: should be "wm command window ?value?"}} +test unixWm-15.3 {Tk_WmCmd procedure, "command" option} {unix testwrapper} { set result {} lappend result [wm command .t] wm command .t "test command" @@ -621,7 +615,7 @@ test unixWm-15.5 {Tk_WmCmd procedure, "command" option} { test unixWm-16.1 {Tk_WmCmd procedure, "deiconify" option} { list [catch {wm deiconify .t 12} msg] $msg -} {1 {wrong # arguments: must be "wm deiconify window"}} +} {1 {wrong # args: should be "wm deiconify window"}} test unixWm-16.2 {Tk_WmCmd procedure, "deiconify" option} { catch {destroy .icon} toplevel .icon -width 50 -height 50 -bg red @@ -640,7 +634,7 @@ test unixWm-16.3 {Tk_WmCmd procedure, "deiconify" option} { test unixWm-17.1 {Tk_WmCmd procedure, "focusmodel" option} { list [catch {wm focusmodel .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm focusmodel window ?active|passive?"}} +} {1 {wrong # args: should be "wm focusmodel window ?active|passive?"}} test unixWm-17.2 {Tk_WmCmd procedure, "focusmodel" option} { list [catch {wm focusmodel .t bogus} msg] $msg } {1 {bad argument "bogus": must be active or passive}} @@ -656,7 +650,7 @@ test unixWm-17.3 {Tk_WmCmd procedure, "focusmodel" option} { test unixWm-18.1 {Tk_WmCmd procedure, "frame" option} { list [catch {wm frame .t 12} msg] $msg -} {1 {wrong # arguments: must be "wm frame window"}} +} {1 {wrong # args: should be "wm frame window"}} test unixWm-18.2 {Tk_WmCmd procedure, "frame" option} nonPortable { expr [wm frame .t] == [winfo id .t] } {0} @@ -673,7 +667,7 @@ test unixWm-18.3 {Tk_WmCmd procedure, "frame" option} nonPortable { test unixWm-19.1 {Tk_WmCmd procedure, "geometry" option} { list [catch {wm geometry .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm geometry window ?newGeometry?"}} +} {1 {wrong # args: should be "wm geometry window ?newGeometry?"}} test unixWm-19.2 {Tk_WmCmd procedure, "geometry" option} nonPortable { wm geometry .t -1+5 update @@ -710,10 +704,10 @@ test unixWm-19.6 {Tk_WmCmd procedure, "geometry" option} { test unixWm-20.1 {Tk_WmCmd procedure, "grid" option} { list [catch {wm grid .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}} +} {1 {wrong # args: should be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}} test unixWm-20.2 {Tk_WmCmd procedure, "grid" option} { list [catch {wm grid .t 12 13 14 15 16} msg] $msg -} {1 {wrong # arguments: must be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}} +} {1 {wrong # args: should be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}} test unixWm-20.3 {Tk_WmCmd procedure, "grid" option} { set result {} lappend result [wm grid .t] @@ -755,11 +749,11 @@ update test unixWm-21.1 {Tk_WmCmd procedure, "group" option} { list [catch {wm group .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm group window ?pathName?"}} +} {1 {wrong # args: should be "wm group window ?pathName?"}} test unixWm-21.2 {Tk_WmCmd procedure, "group" option} { list [catch {wm group .t bogus} msg] $msg } {1 {bad window path name "bogus"}} -test unixWm-21.3 {Tk_WmCmd procedure, "group" option} {unixOnly} { +test unixWm-21.3 {Tk_WmCmd procedure, "group" option} {unix testwrapper} { set result {} lappend result [wm group .t] wm group .t . @@ -771,7 +765,7 @@ test unixWm-21.3 {Tk_WmCmd procedure, "group" option} {unixOnly} { WM_HINTS] 0]]] lappend result [wm group .t] $bit } {{} . 0x40 {} 0x0} -test unixWm-21.4 {Tk_WmCmd procedure, "group" option, make window exist} {unixOnly} { +test unixWm-21.4 {Tk_WmCmd procedure, "group" option, make window exist} {unix testwrapper} { catch {destroy .t2} toplevel .t2 wm geom .t2 +0+0 @@ -781,7 +775,7 @@ test unixWm-21.4 {Tk_WmCmd procedure, "group" option, make window exist} {unixOn destroy .t2 set result } {0} -test unixWm-21.5 {Tk_WmCmd procedure, "group" option, create leader wrapper} {unixOnly} { +test unixWm-21.5 {Tk_WmCmd procedure, "group" option, create leader wrapper} {unix testwrapper} { catch {destroy .t2} catch {destroy .t3} toplevel .t2 -width 120 -height 300 @@ -795,10 +789,10 @@ test unixWm-21.5 {Tk_WmCmd procedure, "group" option, create leader wrapper} {un set result } {{} 0} -test unixWm-22.1 {Tk_WmCmd procedure, "iconbitmap" option} { +test unixWm-22.1 {Tk_WmCmd procedure, "iconbitmap" option} unix { list [catch {wm iconbitmap .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm iconbitmap window ?bitmap?"}} -test unixWm-22.2 {Tk_WmCmd procedure, "iconbitmap" option} {unixOnly} { +} {1 {wrong # args: should be "wm iconbitmap window ?bitmap?"}} +test unixWm-22.2 {Tk_WmCmd procedure, "iconbitmap" option} {unix testwrapper} { set result {} lappend result [wm iconbitmap .t] wm iconbitmap .t questhead @@ -816,7 +810,7 @@ test unixWm-22.3 {Tk_WmCmd procedure, "iconbitmap" option} { test unixWm-23.1 {Tk_WmCmd procedure, "iconify" option} { list [catch {wm iconify .t 12} msg] $msg -} {1 {wrong # arguments: must be "wm iconify window"}} +} {1 {wrong # args: should be "wm iconify window"}} test unixWm-23.2 {Tk_WmCmd procedure, "iconify" option} { catch {destroy .t2} toplevel .t2 @@ -869,8 +863,8 @@ test unixWm-23.6 {Tk_WmCmd procedure, "iconify" option} { test unixWm-24.1 {Tk_WmCmd procedure, "iconmask" option} { list [catch {wm iconmask .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm iconmask window ?bitmap?"}} -test unixWm-24.2 {Tk_WmCmd procedure, "iconmask" option} {unixOnly} { +} {1 {wrong # args: should be "wm iconmask window ?bitmap?"}} +test unixWm-24.2 {Tk_WmCmd procedure, "iconmask" option} {unix testwrapper} { set result {} lappend result [wm iconmask .t] wm iconmask .t questhead @@ -888,11 +882,11 @@ test unixWm-24.3 {Tk_WmCmd procedure, "iconmask" option} { test unixWm-25.1 {Tk_WmCmd procedure, "iconname" option} { list [catch {wm icon .t} msg] $msg -} {1 {unknown or ambiguous option "icon": must be aspect, client, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, state, title, transient, or withdraw}} +} {1 {ambiguous option "icon": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} test unixWm-25.2 {Tk_WmCmd procedure, "iconname" option} { list [catch {wm iconname .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm iconname window ?newName?"}} -test unixWm-25.3 {Tk_WmCmd procedure, "iconname" option} {unixOnly} { +} {1 {wrong # args: should be "wm iconname window ?newName?"}} +test unixWm-25.3 {Tk_WmCmd procedure, "iconname" option} {unix testwrapper} { set result {} lappend result [wm iconname .t] wm iconname .t test_name @@ -903,11 +897,11 @@ test unixWm-25.3 {Tk_WmCmd procedure, "iconname" option} {unixOnly} { test unixWm-26.1 {Tk_WmCmd procedure, "iconposition" option} { list [catch {wm iconposition .t 12} msg] $msg -} {1 {wrong # arguments: must be "wm iconposition window ?x y?"}} +} {1 {wrong # args: should be "wm iconposition window ?x y?"}} test unixWm-26.2 {Tk_WmCmd procedure, "iconposition" option} { list [catch {wm iconposition .t 12 13 14} msg] $msg -} {1 {wrong # arguments: must be "wm iconposition window ?x y?"}} -test unixWm-26.3 {Tk_WmCmd procedure, "iconposition" option} {unixOnly} { +} {1 {wrong # args: should be "wm iconposition window ?x y?"}} +test unixWm-26.3 {Tk_WmCmd procedure, "iconposition" option} {unix testwrapper} { set result {} lappend result [wm iconposition .t] wm iconposition .t 10 15 @@ -928,8 +922,8 @@ test unixWm-26.5 {Tk_WmCmd procedure, "iconposition" option} { test unixWm-27.1 {Tk_WmCmd procedure, "iconwindow" option} { list [catch {wm iconwindow .t 12 13} msg] $msg -} {1 {wrong # arguments: must be "wm iconwindow window ?pathName?"}} -test unixWm-27.2 {Tk_WmCmd procedure, "iconwindow" option} {unixOnly} { +} {1 {wrong # args: should be "wm iconwindow window ?pathName?"}} +test unixWm-27.2 {Tk_WmCmd procedure, "iconwindow" option} {unix testwrapper} { catch {destroy .icon} toplevel .icon -width 50 -height 50 -bg green set result {} @@ -994,29 +988,11 @@ test unixWm-27.7 {Tk_WmCmd procedure, "iconwindow" option, withdrawing icon} { set result } {normal 1 icon 0} -test unixWm-28.1 {Tk_WmCmd procedure, "maxsize" option} { - list [catch {wm maxsize} msg] $msg -} {1 {wrong # args: should be "wm option window ?arg ...?"}} -test unixWm-28.2 {Tk_WmCmd procedure, "maxsize" option} { - list [catch {wm maxsize . a} msg] $msg -} {1 {wrong # arguments: must be "wm maxsize window ?width height?"}} -test unixWm-28.3 {Tk_WmCmd procedure, "maxsize" option} { - list [catch {wm maxsize . a b c} msg] $msg -} {1 {wrong # arguments: must be "wm maxsize window ?width height?"}} -test unixWm-28.4 {Tk_WmCmd procedure, "maxsize" option} {nonPortable} { +test unixWm-28.1 {Tk_WmCmd procedure, "maxsize" option} {nonPortable} { wm maxsize .t } {1137 870} -test unixWm-28.5 {Tk_WmCmd procedure, "maxsize" option} { - list [catch {wm maxsize . x 100} msg] $msg -} {1 {expected integer but got "x"}} -test unixWm-28.6 {Tk_WmCmd procedure, "maxsize" option} { - list [catch {wm maxsize . 100 bogus} msg] $msg -} {1 {expected integer but got "bogus"}} -test unixWm-28.7 {Tk_WmCmd procedure, "maxsize" option} { - wm maxsize .t 200 150 - wm maxsize .t -} {200 150} -test unixWm-28.8 {Tk_WmCmd procedure, "maxsize" option} {nonPortable} { + +test unixWm-28.2 {Tk_WmCmd procedure, "maxsize" option} {nonPortable} { # Not portable, because some window managers let applications override # minsize and maxsize. @@ -1032,29 +1008,7 @@ toplevel .t -width 100 -height 50 wm geom .t +0+0 update -test unixWm-29.1 {Tk_WmCmd procedure, "minsize" option} { - list [catch {wm minsize} msg] $msg -} {1 {wrong # args: should be "wm option window ?arg ...?"}} -test unixWm-29.2 {Tk_WmCmd procedure, "minsize" option} { - list [catch {wm minsize . a} msg] $msg -} {1 {wrong # arguments: must be "wm minsize window ?width height?"}} -test unixWm-29.3 {Tk_WmCmd procedure, "minsize" option} { - list [catch {wm minsize . a b c} msg] $msg -} {1 {wrong # arguments: must be "wm minsize window ?width height?"}} -test unixWm-29.4 {Tk_WmCmd procedure, "minsize" option} { - wm minsize .t -} {1 1} -test unixWm-29.5 {Tk_WmCmd procedure, "minsize" option} { - list [catch {wm minsize . x 100} msg] $msg -} {1 {expected integer but got "x"}} -test unixWm-29.6 {Tk_WmCmd procedure, "minsize" option} { - list [catch {wm minsize . 100 bogus} msg] $msg -} {1 {expected integer but got "bogus"}} -test unixWm-29.7 {Tk_WmCmd procedure, "minsize" option} { - wm minsize .t 200 150 - wm minsize .t -} {200 150} -test unixWm-29.8 {Tk_WmCmd procedure, "minsize" option} {nonPortable} { +test unixWm-29.1 {Tk_WmCmd procedure, "minsize" option} {nonPortable} { # Not portable, because some window managers let applications override # minsize and maxsize. @@ -1072,7 +1026,7 @@ update test unixWm-30.1 {Tk_WmCmd procedure, "overrideredirect" option} { list [catch {wm overrideredirect .t 1 2} msg] $msg -} {1 {wrong # arguments: must be "wm overrideredirect window ?boolean?"}} +} {1 {wrong # args: should be "wm overrideredirect window ?boolean?"}} test unixWm-30.2 {Tk_WmCmd procedure, "overrideredirect" option} { list [catch {wm overrideredirect .t boo} msg] $msg } {1 {expected boolean value but got "boo"}} @@ -1087,8 +1041,8 @@ test unixWm-30.3 {Tk_WmCmd procedure, "overrideredirect" option} { test unixWm-31.1 {Tk_WmCmd procedure, "positionfrom" option} { list [catch {wm positionfrom .t 1 2} msg] $msg -} {1 {wrong # arguments: must be "wm positionfrom window ?user/program?"}} -test unixWm-31.2 {Tk_WmCmd procedure, "positionfrom" option} {unixOnly} { +} {1 {wrong # args: should be "wm positionfrom window ?user/program?"}} +test unixWm-31.2 {Tk_WmCmd procedure, "positionfrom" option} {unix testwrapper} { set result {} lappend result [wm positionfrom .t] wm positionfrom .t program @@ -1108,7 +1062,7 @@ test unixWm-31.3 {Tk_WmCmd procedure, "positionfrom" option} { test unixWm-32.1 {Tk_WmCmd procedure, "protocol" option} { list [catch {wm protocol .t 1 2 3} msg] $msg -} {1 {wrong # arguments: must be "wm protocol window ?name? ?command?"}} +} {1 {wrong # args: should be "wm protocol window ?name? ?command?"}} test unixWm-32.2 {Tk_WmCmd procedure, "protocol" option} { wm protocol .t {foo a} {a b c} wm protocol .t bar {test script for bar} @@ -1117,7 +1071,7 @@ test unixWm-32.2 {Tk_WmCmd procedure, "protocol" option} { wm protocol .t bar {} set result } {bar {foo a}} -test unixWm-32.3 {Tk_WmCmd procedure, "protocol" option} {unixOnly} { +test unixWm-32.3 {Tk_WmCmd procedure, "protocol" option} {unix testwrapper} { set result {} lappend result [wm protocol .t] set x {} @@ -1159,10 +1113,10 @@ test unixWm-32.5 {Tk_WmCmd procedure, "protocol" option} { test unixWm-33.1 {Tk_WmCmd procedure, "resizable" option} { list [catch {wm resizable . a} msg] $msg -} {1 {wrong # arguments: must be "wm resizable window ?width height?"}} +} {1 {wrong # args: should be "wm resizable window ?width height?"}} test unixWm-33.2 {Tk_WmCmd procedure, "resizable" option} { list [catch {wm resizable . a b c} msg] $msg -} {1 {wrong # arguments: must be "wm resizable window ?width height?"}} +} {1 {wrong # args: should be "wm resizable window ?width height?"}} test unixWm-33.3 {Tk_WmCmd procedure, "resizable" option} { list [catch {wm resizable .foo a b c} msg] $msg } {1 {bad window path name ".foo"}} @@ -1190,8 +1144,8 @@ test unixWm-33.6 {Tk_WmCmd procedure, "resizable" option} { test unixWm-34.1 {Tk_WmCmd procedure, "sizefrom" option} { list [catch {wm sizefrom .t 1 2} msg] $msg -} {1 {wrong # arguments: must be "wm sizefrom window ?user|program?"}} -test unixWm-34.2 {Tk_WmCmd procedure, "sizefrom" option} {unixOnly} { +} {1 {wrong # args: should be "wm sizefrom window ?user|program?"}} +test unixWm-34.2 {Tk_WmCmd procedure, "sizefrom" option} {unix testwrapper} { set result {} lappend result [wm sizefrom .t] wm sizefrom .t program @@ -1209,12 +1163,12 @@ test unixWm-34.3 {Tk_WmCmd procedure, "sizefrom" option} { list [catch {wm sizefrom .t none} msg] $msg } {1 {bad argument "none": must be program or user}} -test unixWm-35.1 {Tk_WmCmd procedure, "state" option} { +test unixWm-35.1 {Tk_WmCmd procedure, "state" option} unix { list [catch {wm state .t 1} msg] $msg -} {1 {bad argument "1": must be normal, iconic or withdrawn}} +} {1 {bad argument "1": must be normal, iconic, or withdrawn}} test unixWm-35.2 {Tk_WmCmd procedure, "state" option} { list [catch {wm state .t iconic 1} msg] $msg -} {1 {wrong # arguments: must be "wm state window ?state?"}} +} {1 {wrong # args: should be "wm state window ?state?"}} test unixWm-35.3 {Tk_WmCmd procedure, "state" option} { set result {} catch {destroy .t2} @@ -1252,8 +1206,8 @@ test unixWm-35.4 {Tk_WmCmd procedure, "state" option} { test unixWm-36.1 {Tk_WmCmd procedure, "title" option} { list [catch {wm title .t 1 2} msg] $msg -} {1 {wrong # arguments: must be "wm title window ?newTitle?"}} -test unixWm-36.2 {Tk_WmCmd procedure, "title" option} {unixOnly} { +} {1 {wrong # args: should be "wm title window ?newTitle?"}} +test unixWm-36.2 {Tk_WmCmd procedure, "title" option} {unix testwrapper} { set result {} lappend result [wm title .t] [testprop [testwrapper .t] WM_NAME] wm title .t "Test window" @@ -1262,13 +1216,7 @@ test unixWm-36.2 {Tk_WmCmd procedure, "title" option} {unixOnly} { lappend result [wm title .t] [testprop [testwrapper .t] WM_NAME] } {t t {Test window} {Test window}} -test unixWm-37.1 {Tk_WmCmd procedure, "transient" option} { - list [catch {wm transient .t 1 2} msg] $msg -} {1 {wrong # arguments: must be "wm transient window ?master?"}} -test unixWm-37.2 {Tk_WmCmd procedure, "transient" option} { - list [catch {wm transient .t foo} msg] $msg -} {1 {bad window path name "foo"}} -test unixWm-37.3 {Tk_WmCmd procedure, "transient" option} {unixOnly} { +test unixWm-37.3 {Tk_WmCmd procedure, "transient" option} {unix testwrapper} { set result {} catch {destroy .t2} toplevel .t2 -width 120 -height 300 @@ -1285,7 +1233,18 @@ test unixWm-37.3 {Tk_WmCmd procedure, "transient" option} {unixOnly} { destroy .t2 set result } {{} {} .t 0 {} 0x0} -test unixWm-37.4 {Tk_WmCmd procedure, "transient" option, create master wrapper} {unixOnly} { +test unixWm-37.4 {TkWmDeadWindow, destroy on master should clear transient} {unix testwrapper} { + catch {destroy .t2} + toplevel .t2 + catch {destroy .t3} + toplevel .t3 + wm transient .t2 .t3 + update + destroy .t3 + update + list [wm transient .t2] [testprop [testwrapper .t2] WM_TRANSIENT_FOR] +} {{} 0x0} +test unixWm-37.5 {Tk_WmCmd procedure, "transient" option, create master wrapper} {unix testwrapper} { catch {destroy .t2} catch {destroy .t3} toplevel .t2 -width 120 -height 300 @@ -1301,7 +1260,7 @@ test unixWm-37.4 {Tk_WmCmd procedure, "transient" option, create master wrapper} test unixWm-38.1 {Tk_WmCmd procedure, "withdraw" option} { list [catch {wm withdraw .t 1} msg] $msg -} {1 {wrong # arguments: must be "wm withdraw window"}} +} {1 {wrong # args: should be "wm withdraw window"}} test unixWm-38.2 {Tk_WmCmd procedure, "withdraw" option} { catch {destroy .t2} toplevel .t2 -width 120 -height 300 @@ -1321,7 +1280,7 @@ test unixWm-38.3 {Tk_WmCmd procedure, "withdraw" option} { test unixWm-39.1 {Tk_WmCmd procedure, miscellaneous} { list [catch {wm unknown .t} msg] $msg -} {1 {unknown or ambiguous option "unknown": must be aspect, client, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, state, title, transient, or withdraw}} +} {1 {bad option "unknown": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} catch {destroy .t} catch {destroy .icon} @@ -1358,7 +1317,7 @@ test unixWm-41.1 {ConfigureEvent procedure, internally generated size changes} { sleep 500 lappend result [winfo width .t] [winfo height .t] } {400 150 200 300} -test unixWm-41.2 {ConfigureEvent procedure, menubars} {nonPortable} { +test unixWm-41.2 {ConfigureEvent procedure, menubars} {nonPortable testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 -bd 2 -relief raised wm geom .t +0+0 @@ -1542,7 +1501,7 @@ test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} { } [list [expr [winfo screenwidth .t] - 110] 2] catch {destroy .t} -test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unixOnly} { +test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unix testwrapper} { catch {destroy .t} toplevel .t -width 80 -height 60 wm resizable .t 0 0 @@ -1554,7 +1513,7 @@ test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unix list [expr [lindex $property 5]] [expr [lindex $property 6]] \ [expr [lindex $property 7]] [expr [lindex $property 8]] } {180 20 180 20} -test unixWm-44.10 {UpdateGeometryInfo procedure, menubar changing} { +test unixWm-44.10 {UpdateGeometryInfo procedure, menubar changing} testmenubar { catch {destroy .t} toplevel .t -width 80 -height 60 wm resizable .t 0 0 @@ -1569,7 +1528,7 @@ test unixWm-44.10 {UpdateGeometryInfo procedure, menubar changing} { list [update] [destroy .t] } {{} {}} -test unixWm-45.1 {UpdateSizeHints procedure, grid information} {unixOnly} { +test unixWm-45.1 {UpdateSizeHints procedure, grid information} {unix testwrapper} { catch {destroy .t} toplevel .t -width 80 -height 60 wm grid .t 6 10 10 5 @@ -1582,7 +1541,7 @@ test unixWm-45.1 {UpdateSizeHints procedure, grid information} {unixOnly} { [expr [lindex $property 7]] [expr [lindex $property 8]] \ [expr [lindex $property 9]] [expr [lindex $property 10]] } {40 30 320 210 10 5} -test unixWm-45.2 {UpdateSizeHints procedure} {unixOnly} { +test unixWm-45.2 {UpdateSizeHints procedure} {unix testwrapper} { catch {destroy .t} toplevel .t -width 80 -height 60 wm minsize .t 30 40 @@ -1594,7 +1553,7 @@ test unixWm-45.2 {UpdateSizeHints procedure} {unixOnly} { [expr [lindex $property 7]] [expr [lindex $property 8]] \ [expr [lindex $property 9]] [expr [lindex $property 10]] } {30 40 200 500 1 1} -test unixWm-45.3 {UpdateSizeHints procedure, grid with menu} { +test unixWm-45.3 {UpdateSizeHints procedure, grid with menu} {testmenubar testwrapper} { catch {destroy .t} toplevel .t -width 80 -height 60 frame .t.menu -height 23 -width 50 @@ -1610,7 +1569,7 @@ test unixWm-45.3 {UpdateSizeHints procedure, grid with menu} { [expr [lindex $property 7]] [expr [lindex $property 8]] \ [expr [lindex $property 9]] [expr [lindex $property 10]] } {60 40 53 320 233 10 5} -test unixWm-45.4 {UpdateSizeHints procedure, not resizable with menu} { +test unixWm-45.4 {UpdateSizeHints procedure, not resizable with menu} {testmenubar testwrapper} { catch {destroy .t} toplevel .t -width 80 -height 60 frame .t.menu -height 23 -width 50 @@ -1737,7 +1696,7 @@ test unixWm-49.1 {Tk_GetRootCoords procedure} { tkwait visibility .t list [winfo rootx .t.f.f] [winfo rooty .t.f.f] } {202 192} -test unixWm-49.2 {Tk_GetRootCoords procedure, menubars} {unixOnly} { +test unixWm-49.2 {Tk_GetRootCoords procedure, menubars} {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 -bd 2 -relief raised wm geom .t +0+0 @@ -1755,12 +1714,10 @@ test unixWm-49.2 {Tk_GetRootCoords procedure, menubars} {unixOnly} { [expr [winfo rootx .t.f] - $x] [expr [winfo rooty .t.f] - $y] } {52 7 12 62} -foreach w [winfo children .] { - catch {destroy $w} -} +deleteWindows wm iconify . test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords} { - eval destroy [winfo children .] + deleteWindows toplevel .t -width 300 -height 400 -bg green wm geom .t +40+0 tkwait visibility .t @@ -1780,7 +1737,7 @@ test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords} { [winfo containing [expr $x + 220] [expr $y + 250]] } {{} {} .t {} .t2 .t2 {} .t} test unixWm-50.2 {Tk_CoordsToWindow procedure, finding a toplevel, y-coords and overrideredirect} { - eval destroy [winfo children .] + deleteWindows toplevel .t -width 300 -height 400 -bg yellow wm geom .t +0+50 tkwait visibility .t @@ -1801,14 +1758,17 @@ test unixWm-50.2 {Tk_CoordsToWindow procedure, finding a toplevel, y-coords and [winfo containing [expr $x +150] [expr $y2 + 80]] \ [winfo containing [expr $x +150] [expr $y + 450]] } {{} {} .t .t .t2 .t2 .t {}} -test unixWm-50.3 {Tk_CoordsToWindow procedure, finding a toplevel with embedding} { - eval destroy [winfo children .] +test unixWm-50.3 { + Tk_CoordsToWindow procedure, finding a toplevel with embedding +} -constraints tempNotWin -setup { + deleteWindows toplevel .t -width 300 -height 400 -bg blue wm geom .t +0+50 frame .t.f -container 1 place .t.f -x 150 -y 50 tkwait visibility .t.f setupbg +} -body { dobg " wm withdraw . toplevel .x -width 100 -height 80 -use [winfo id .t.f] -bg yellow @@ -1823,8 +1783,9 @@ test unixWm-50.3 {Tk_CoordsToWindow procedure, finding a toplevel with embedding set y [winfo rooty .t] lappend result [winfo containing [expr $x + 200] [expr $y + 49]] \ [winfo containing [expr $x + 200] [expr $y +50]] -} {{} .x .t .t.f} -cleanupbg +} -cleanup { + cleanupbg +} -result {{} .x .t .t.f} test unixWm-50.4 {Tk_CoordsToWindow procedure, window in other application} { catch {destroy .t} catch {interp delete slave} @@ -1832,15 +1793,15 @@ test unixWm-50.4 {Tk_CoordsToWindow procedure, window in other application} { wm geometry .t +0+0 tkwait visibility .t interp create slave - load {} tk slave + load {} Tk slave slave eval {wm geometry . 200x200+0+0; tkwait visibility .} set result [list [winfo containing 100 100] \ [slave eval {winfo containing 100 100}]] interp delete slave set result } {{} .} -test unixWm-50.5 {Tk_CoordsToWindow procedure, handling menubars} {unixOnly} { - eval destroy [winfo children .] +test unixWm-50.5 {Tk_CoordsToWindow procedure, handling menubars} {unix testmenubar} { + deleteWindows toplevel .t -width 300 -height 400 -bd 2 -relief raised frame .t.f -width 150 -height 120 -bg green place .t.f -x 10 -y 150 @@ -1862,7 +1823,7 @@ test unixWm-50.5 {Tk_CoordsToWindow procedure, handling menubars} {unixOnly} { [winfo containing [expr $x + 12] [expr $y + 152]] } {{} .t.menu .t.menu .t.menu.f .t .t .t.f} test unixWm-50.6 {Tk_CoordsToWindow procedure, embedding within one app.} { - eval destroy [winfo children .] + deleteWindows toplevel .t -width 300 -height 400 -bg orange wm geom .t +0+50 frame .t.f -container 1 @@ -1938,7 +1899,7 @@ test unixWm-50.10 {Tk_CoordsToWindow procedure, unmapped windows} { update lappend result [winfo containing 100 100] } {.t.f .t} -eval destroy [winfo children .] +deleteWindows wm deiconify . # No tests for UpdateVRootGeometry, Tk_GetVRootGeometry, @@ -1995,9 +1956,7 @@ test unixWm-51.5 {TkWmRestackToplevel procedure, basic tests} {nonPortable} { list $result [winfo containing [winfo rootx .raise2] \ [winfo rooty .raise2]] } {.raise1 .raise3} -foreach w [winfo children .] { - catch {destroy $w} -} +deleteWindows test unixWm-51.6 {TkWmRestackToplevel procedure, window to be stacked isn't mapped} { catch {destroy .t} toplevel .t -width 200 -height 200 -bg green @@ -2156,7 +2115,7 @@ test unixWm-53.2 {TkWmRemoveFromColormapWindows procedure} { wm colormap .t } {} -test unixWm-54.1 {TkpMakeMenuWindow procedure, setting save_under} { +test unixWm-54.1 {TkpMakeMenuWindow procedure, setting save_under} unix { catch {destroy .t} catch {destroy .m} toplevel .t -width 300 -height 200 -bd 2 -relief raised @@ -2173,7 +2132,7 @@ test unixWm-54.1 {TkpMakeMenuWindow procedure, setting save_under} { destroy .m set x } {no event} -test unixWm-54.2 {TkpMakeMenuWindow procedure, setting override_redirect} { +test unixWm-54.2 {TkpMakeMenuWindow procedure, setting override_redirect} unix { catch {destroy .m} menu .m .m add command -label First @@ -2188,7 +2147,7 @@ test unixWm-54.2 {TkpMakeMenuWindow procedure, setting override_redirect} { # No tests for TkGetPointerCoords, CreateWrapper, or GetMaxSize. -test unixWm-55.1 {TkUnixSetMenubar procedure} {unixOnly} { +test unixWm-55.1 {TkUnixSetMenubar procedure} {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 -bd 2 -relief raised wm geom .t +0+0 @@ -2200,7 +2159,7 @@ test unixWm-55.1 {TkUnixSetMenubar procedure} {unixOnly} { [expr [winfo rootx .t] - [winfo rootx .t.f]] \ [expr [winfo rooty .t] - [winfo rooty .t.f]] } {1 300x30+0+0 0 30} -test unixWm-55.2 {TkUnixSetMenubar procedure, removing menubar} {unixOnly} { +test unixWm-55.2 {TkUnixSetMenubar procedure, removing menubar} {unix testmenubar} { catch {destroy .t} catch {destroy .f} toplevel .t -width 300 -height 200 -bd 2 -relief raised @@ -2219,7 +2178,7 @@ test unixWm-55.2 {TkUnixSetMenubar procedure, removing menubar} {unixOnly} { [expr [winfo rootx .] - [winfo rootx .f]] \ [expr [winfo rooty .] - [winfo rooty .f]] } {0 300x30+0+0 0 0 0 0} -test unixWm-55.3 {TkUnixSetMenubar procedure, removing geometry manager} {unixOnly} { +test unixWm-55.3 {TkUnixSetMenubar procedure, removing geometry manager} {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 -bd 2 -relief raised wm geom .t +0+0 @@ -2236,7 +2195,7 @@ test unixWm-55.3 {TkUnixSetMenubar procedure, removing geometry manager} {unixOn update lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y] } {0 0 0 0} -test unixWm-55.4 {TkUnixSetMenubar procedure, toplevel not yet created} {unixOnly} { +test unixWm-55.4 {TkUnixSetMenubar procedure, toplevel not yet created} {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 -bd 2 -relief raised frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green @@ -2247,7 +2206,7 @@ test unixWm-55.4 {TkUnixSetMenubar procedure, toplevel not yet created} {unixOnl [expr [winfo rootx .t] - [winfo rootx .t.f]] \ [expr [winfo rooty .t] - [winfo rooty .t.f]] } {1 300x30+0+0 0 30} -test unixWm-55.5 {TkUnixSetMenubar procedure, changing menubar} {unixOnly} { +test unixWm-55.5 {TkUnixSetMenubar procedure, changing menubar} {unix testmenubar} { catch {destroy .t} catch {destroy .f} toplevel .t -width 300 -height 200 -bd 2 -relief raised @@ -2266,7 +2225,7 @@ test unixWm-55.5 {TkUnixSetMenubar procedure, changing menubar} {unixOnly} { lappend result [winfo ismapped .f] [winfo ismapped .t.f] lappend result [expr [winfo rooty .f] - $y] } {0 1 0 1 0 0} -test unixWm-55.6 {TkUnixSetMenubar procedure, changing menubar to self} {unixOnly} { +test unixWm-55.6 {TkUnixSetMenubar procedure, changing menubar to self} {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 -bd 2 -relief raised frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green @@ -2279,7 +2238,7 @@ test unixWm-55.6 {TkUnixSetMenubar procedure, changing menubar to self} {unixOnl [expr [winfo rootx .t] - [winfo rootx .t.f]] \ [expr [winfo rooty .t] - [winfo rooty .t.f]] } {1 300x30+0+0 0 30} -test unixWm-55.7 {TkUnixSetMenubar procedure, unsetting event handler} {unixOnly} { +test unixWm-55.7 {TkUnixSetMenubar procedure, unsetting event handler} {unix testmenubar} { catch {destroy .t} catch {destroy .f} toplevel .t -width 300 -height 200 -bd 2 -relief raised @@ -2299,7 +2258,7 @@ test unixWm-55.7 {TkUnixSetMenubar procedure, unsetting event handler} {unixOnly lappend result [expr [winfo rooty .t] - $y] } {30 40 40} -test unixWm-56.1 {MenubarDestroyProc procedure} {unixOnly} { +test unixWm-56.1 {MenubarDestroyProc procedure} {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 -bd 2 -relief raised wm geom .t +0+0 @@ -2314,7 +2273,7 @@ test unixWm-56.1 {MenubarDestroyProc procedure} {unixOnly} { lappend result [expr [winfo rooty .t] - $y] } {30 0} -test unixWm-57.1 {MenubarReqProc procedure} {unixOnly} { +test unixWm-57.1 {MenubarReqProc procedure} {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 -bd 2 -relief raised wm geom .t +0+0 @@ -2329,7 +2288,7 @@ test unixWm-57.1 {MenubarReqProc procedure} {unixOnly} { update lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y] } {0 10 0 100} -test unixWm-57.2 {MenubarReqProc procedure} {unixOnly} { +test unixWm-57.2 {MenubarReqProc procedure} {unix testmenubar} { catch {destroy .t} toplevel .t -width 300 -height 200 -bd 2 -relief raised wm geom .t +0+0 @@ -2345,7 +2304,7 @@ test unixWm-57.2 {MenubarReqProc procedure} {unixOnly} { lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y] } {0 20 0 1} -test unixWm-58.1 {UpdateCommand procedure, DString gets reallocated} {unixOnly} { +test unixWm-58.1 {UpdateCommand procedure, DString gets reallocated} {unix testwrapper} { catch {destroy .t} toplevel .t -width 100 -height 50 wm geom .t +0+0 @@ -2378,44 +2337,38 @@ argumentNumber18 # Test exit processing and cleanup: -test unixWm-58.1 {exit processing} { - catch {removeFile script} - set fd [open script w] - puts $fd { +test unixWm-59.1 {exit processing} { + set script [makeFile { update exit - } - close $fd - if {[catch {exec $::tcltest::tktest script -geometry 10x10+0+0} msg]} { + } script] + if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { set error 1 } else { set error 0 } + removeFile script list $error $msg } {0 {}} -test unixWm-58.2 {exit processing} { - catch {removeFile script} - set fd [open script w] - puts $fd { +test unixWm-59.2 {exit processing} { + set script [makeFile { interp create x x eval {set argc 2} x eval {set argv "-geometry 10x10+0+0"} x eval {load {} Tk} update exit - } - close $fd - if {[catch {exec $::tcltest::tktest script -geometry 10x10+0+0} msg]} { + } script] + if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { set error 1 } else { set error 0 } + removeFile script list $error $msg } {0 {}} -test unixWm-58.3 {exit processing} { - catch {removeFile script} - set fd [open script w] - puts $fd { +test unixWm-59.3 {exit processing} { + set script [makeFile { interp create x x eval {set argc 2} x eval {set argv "-geometry 10x10+0+0"} @@ -2428,33 +2381,28 @@ test unixWm-58.3 {exit processing} { proc destroy_x {} {interp delete x} update exit - } - close $fd - if {[catch {exec $::tcltest::tktest script -geometry 10x10+0+0} msg]} { + } script] + if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { set error 1 } else { set error 0 } + removeFile script list $error $msg } {0 {}} +test unixWm-60.1 {wm attributes} unix { + destroy .t + toplevel .t + wm attributes .t +} {} +test unixWm-60.2 {wm attributes} unix { + destroy .t + toplevel .t + list [catch {wm attributes .t -foo} msg] $msg +} {1 {wrong # args: should be "wm attributes window"}} # cleanup catch {destroy .t} -catch {removeFile script} ::tcltest::cleanupTests return - - - - - - - - - - - - - - |