diff options
Diffstat (limited to 'tests/unixWm.test')
| -rw-r--r-- | tests/unixWm.test | 238 |
1 files changed, 174 insertions, 64 deletions
diff --git a/tests/unixWm.test b/tests/unixWm.test index 5c02963..fa522fd 100644 --- a/tests/unixWm.test +++ b/tests/unixWm.test @@ -1,18 +1,36 @@ # This file is a Tcl script to test out Tk's interactions with -# the window manager, including the "wm" command. It is organized -# in the standard fashion for Tcl tests. +# the window manager, including the "wm" command. # # Copyright © 1992-1994 The Regents of the University of California. # Copyright © 1994-1997 Sun Microsystems, Inc. # Copyright © 1998-1999 Scriptics Corporation. # All rights reserved. -package require tcltest 2.2 -eval tcltest::configure $argv -tcltest::loadTestedCommands +# +# TESTFILE INITIALIZATION +# + +package require tcltest 2.2; # needed in mode -singleproc 0 -# Procedure to set up a collection of top-level windows +# Load the main script main.tcl, which takes care of: +# - setup for the application and the root window +# - importing commands from the tcltest namespace +# - loading of the testutils mechanism along with its utility procs +# - loading of Tk specific test constraints (additionally to constraints +# provided by the package tcltest) +source [file join [tcltest::configure -testdir] main.tcl] +# Ensure a pristine initial window state +resetWindows + +# +# LOCAL UTILITY PROCS +# + +# makeToplevels -- +# +# Set up a collection of top-level windows +# proc makeToplevels {} { deleteWindows foreach i {.raise1 .raise2 .raise3} { @@ -22,6 +40,10 @@ proc makeToplevels {} { } } +# +# COMMON TEST SETUP +# + # On macOS windows are not allowed to overlap the menubar at the top of the # screen or the dock. So tests which move a window and then check whether it # got moved to the requested location should use a y coordinate larger than the @@ -30,7 +52,6 @@ proc makeToplevels {} { # macOS 15 (Sequoia) it became impossible for the y coordinate of the top # of a window to be less than 10 plus the menubar height (as reported by # [[NSApp mainMenu] menuBarHeight]). - if {[tk windowingsystem] eq "aqua"} { set mb [expr [testmenubarheight] + 11] set X 100 @@ -44,6 +65,10 @@ if {[tk windowingsystem] eq "aqua"} { set Y5 5 } +# +# TESTS +# + set i 1 foreach geom "+$X+80 +80+$Y0 +$X+$Y0" { destroy .t @@ -56,12 +81,14 @@ foreach geom "+$X+80 +80+$Y0 +$X+$Y0" { incr i } +# +# COMMON TEST SETUP +# + # The tests below are tricky because window managers don't all move # windows correctly. Try one motion and compute the window manager's # error, then factor this error into the actual tests. In other words, # this just makes sure that things are consistent between moves. - -set i 1 destroy .t toplevel .t -width 100 -height 150 wm geom .t +200+200 @@ -71,6 +98,8 @@ update scan [wm geom .t] %dx%d+%d+%d width height x y set xerr [expr 150-$x] set yerr [expr 150-$y] + +set i 1 foreach geom "+20+80 +80+$Y0 +0+$Y0 -0-0 +0-0 -0+$Y0 -10-5 -10+$Y5 +10-5" { test unixWm-2.$i {moving window while mapped} unix { wm geom .t $geom @@ -182,11 +211,16 @@ test unixWm-5.7 {compounded state changes} {unix nonPortable} { list [winfo ismapped .t] [wm state .t] } {0 iconic} +# +# COMMON TEST SETUP +# + destroy .t toplevel .t -width 200 -height 100 wm geom .t +100+$Y0 wm minsize .t 1 1 update + test unixWm-6.1 {size changes} unix { .t config -width 180 -height 150 update @@ -240,6 +274,10 @@ test unixWm-6.5 {window initially iconic} {unix nonPortable} { list [winfo ismapped .t] [wm state .t] } {1 normal} +# +# COMMON TEST SETUP +# + destroy .m toplevel .m wm overrideredirect .m 1 @@ -248,20 +286,26 @@ 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} 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} unix { + +test unixWm-7.2 {override_redirect and Tk_MoveTopLevelWindow} -constraints unix -setup { + wm geometry .m +[expr 150 - [winfo vrootx .]]+[expr 210 - [winfo vrooty .]] + update +} -body { 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} unix { +} -result {1 normal 150 210} + +test unixWm-7.3 {override_redirect and Tk_MoveTopLevelWindow} -constraints unix -setup { + wm withdraw .m +} -body { list [winfo ismapped .m] -} 0 -destroy .m -destroy .t +} -cleanup { + destroy .m + destroy .t +} -result 0 test unixWm-8.1 {icon windows} unix { destroy .t @@ -311,7 +355,7 @@ test unixWm-8.6 {icon windows} unix { 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} unix { +test unixWm-8.7 {icon windows} -constraints unix -body { destroy .t destroy .icon toplevel .t -width 100 -height 30 @@ -322,8 +366,9 @@ test unixWm-8.7 {icon windows} unix { set result "[wm iconwindow .t] [wm state .icon] [wm state .icon2]" wm iconwindow .t .icon2 lappend result [wm iconwindow .t] [wm state .icon] [wm state .icon2] -} {.icon icon normal .icon2 withdrawn icon} -destroy .icon2 +} -cleanup { + destroy .icon2 +} -result {.icon icon normal .icon2 withdrawn icon} test unixWm-8.8 {icon windows} unix { destroy .t destroy .icon @@ -462,9 +507,12 @@ test unixWm-11.4 {Tk_WmCmd procedure, miscellaneous errors} unix { list [catch {wm geometry .b} msg] $msg } {1 {window ".b" isn't a top-level window}} +# +# COMMON TEST SETUP +# + destroy .t destroy .icon - toplevel .t -width 100 -height 50 wm geom .t +0+0 update @@ -583,6 +631,10 @@ test unixWm-14.7 {Tk_WmCmd procedure, "colormapwindows" option} unix { wm colormapwindows .t2 {} list $x [wm colormapwindows .t2] } {{} {}} + +# +# COMMON TEST CLEANUP +# destroy .t2 test unixWm-15.1 {Tk_WmCmd procedure, "command" option} unix { @@ -744,6 +796,10 @@ test unixWm-20.11 {Tk_WmCmd procedure, "grid" option} unix { list [catch {wm grid .t 10 11 12 -1} msg] $msg } {1 {heightInc can't be <= 0}} +# +# COMMON TEST SETUP +# + destroy .t destroy .icon toplevel .t -width 100 -height 50 @@ -991,6 +1047,10 @@ test unixWm-27.7 {Tk_WmCmd procedure, "iconwindow" option, withdrawing icon} uni set result } {normal 1 icon 0} +# +# COMMON TEST SETUP +# + destroy .t destroy .icon toplevel .t -width 100 -height 50 @@ -1069,6 +1129,10 @@ test unixWm-29.3 {Tk_WmCmd procedure, "minsize" option, setting the format {%d %d} [lindex $hints 5] [lindex $hints 6] } {300 300} +# +# COMMON TEST SETUP +# + destroy .t .icon toplevel .t -width 100 -height 50 wm geom .t +0+0 @@ -1212,14 +1276,12 @@ test unixWm-34.2 {Tk_WmCmd procedure, "sizefrom" option} {unix testwrapper} { test unixWm-34.3 {Tk_WmCmd procedure, "sizefrom" option} unix { list [catch {wm sizefrom .t none} msg] $msg } {1 {bad argument "none": must be program or user}} -if {[tk windowingsystem] eq "aqua"} { - set result_35_1 {1 {bad argument "1": must be iconic, normal, withdrawn, or zoomed}} -} else { - set result_35_1 {1 {bad argument "1": must be iconic, normal, or withdrawn}} -} -test unixWm-35.1 {Tk_WmCmd procedure, "state" option} {unix notAqua} { +test unixWm-35.1.1 {Tk_WmCmd procedure, "state" option} {unix notAqua} { + list [catch {wm state .t 1} msg] $msg +} {1 {bad argument "1": must be iconic, normal, or withdrawn}} +test unixWm-35.1.2 {Tk_WmCmd procedure, "state" option} {unix aqua} { list [catch {wm state .t 1} msg] $msg -} $result_35_1 +} {1 {bad argument "1": must be iconic, normal, withdrawn, or zoomed}} test unixWm-35.2 {Tk_WmCmd procedure, "state" option} unix { list [catch {wm state .t iconic 1} msg] $msg } {1 {wrong # args: should be "wm state window ?state?"}} @@ -1336,6 +1398,9 @@ test unixWm-39.1 {Tk_WmCmd procedure, miscellaneous} unix { list [catch {wm unknown .t} msg] $msg } {1 {bad option "unknown": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbadge, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}} +# +# COMMON TEST CLEANUP +# destroy .t .icon test unixWm-40.1 {Tk_SetGrid procedure, set grid dimensions before turning on grid} {unix nonPortable} { @@ -1528,9 +1593,11 @@ test unixWm-44.5 {UpdateGeometryInfo procedure, negative width} unix { update list [winfo width .t] [winfo height .t] } {1 72} -destroy .t -toplevel .t -width 80 -height 60 -test unixWm-44.6 {UpdateGeometryInfo procedure, negative height} unix { + +test unixWm-44.6 {UpdateGeometryInfo procedure, negative height} -constraints unix -setup { + destroy .t + toplevel .t -width 80 -height 60 +} -body { wm grid .t 18 7 10 12 wm geometry .t +30+40 wm overrideredirect .t 1 @@ -1538,28 +1605,44 @@ test unixWm-44.6 {UpdateGeometryInfo procedure, negative height} unix { wm geometry .t 20x1 update list [winfo width .t] [winfo height .t] -} {100 1} -destroy .t -toplevel .t -width 80 -height 60 -test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} {unix} { +} -result {100 1} + +# +# COMMON TEST SETUP +# +if {! [winfo exists .t]} { + # The expected results for tests 44.7 and 44.8 require that window .t exists. + # That might not be the case if no previous tests are being run that create + # the window (because of the constraint unix or because of test selection + # using the tcltest option "-match" or "-skip"). Therefore, we create a dummy + # window .t here. + frame .t +} + +test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} -constraints unix -setup { + destroy .t + toplevel .t -width 80 -height 60 +} -body { wm overrideredirect .t 1 tkwait visibility .t update wm geometry .t +5-10 update list [winfo x .t] [winfo y .t] -} [list 5 [expr [winfo screenheight .t] - 70]] -destroy .t -toplevel .t -width 80 -height 60 -test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} {unix} { +} -result [list 5 [expr [winfo screenheight .t] - 70]] +test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} -constraints unix -setup { + destroy .t + toplevel .t -width 80 -height 60 +} -body { wm overrideredirect .t 1 tkwait visibility .t update wm geometry .t -30+$Y2 update list [winfo x .t] [winfo y .t] -} [list [expr [winfo screenwidth .t] - 110] $Y2] -destroy .t +} -cleanup { + destroy .t +} -result [list [expr [winfo screenwidth .t] - 110] $Y2] test unixWm-44.9 {UpdateGeometryInfo procedure, updating fixed dimensions} {unix testwrapper} { destroy .t @@ -1686,6 +1769,10 @@ test unixWm-47.1 {WaitRestrictProc procedure} {unix nonPortable} { # I don't know how to test WaitTimeoutProc, WaitForMapNotify, or UpdateHints. +# +# COMMON TEST SETUP +# + destroy .t toplevel .t -width 300 -height 200 wm geometry .t +0+0 @@ -1774,10 +1861,15 @@ test unixWm-49.2 {Tk_GetRootCoords procedure, menubars} {unix testmenubar} { [expr [winfo rootx .t.f] - $x] [expr [winfo rooty .t.f] - $y] } {52 7 12 62} +# +# COMMON TEST SETUP +# + deleteWindows # Make sure that the root window is out of the way! wm geom . +700+700 wm withdraw . + if {[tk windowingsystem] eq "aqua"} { # Modern mac windows have no border. set result_50_1 {{} {} .t .t .t2 {} .t2 .t .t} @@ -1785,6 +1877,11 @@ if {[tk windowingsystem] eq "aqua"} { # Windows are assumed to have a border (invisible in Gnome 3). set result_50_1 {{} {} .t {} .t2 {} .t2 {} .t} } + +if {[tk windowingsystem] eq "aqua"} { + after 1000; # Give Apple's _windowserver some time to catch up. +} + test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords, title bar} {unix failsOnUbuntu failsOnXQuartz} { update toplevel .t -width 300 -height 400 -bg green @@ -1983,6 +2080,10 @@ test unixWm-50.10 {Tk_CoordsToWindow procedure, unmapped windows} unix { update idletasks lappend result [winfo containing 100 100] } {.t.f .t} + +# +# COMMON TEST CLEANUP +# deleteWindows wm deiconify . @@ -2037,7 +2138,12 @@ test unixWm-51.5 {TkWmRestackToplevel procedure, basic tests} {unix nonPortable} list $result [winfo containing [winfo rootx .raise2] \ [winfo rooty .raise2]] } {.raise1 .raise3} + +# +# COMMON TEST CLEANUP +# deleteWindows + test unixWm-51.6 {TkWmRestackToplevel procedure, window to be stacked isn't mapped} unix { wm geometry . +300+300 destroy .t @@ -2093,12 +2199,14 @@ test unixWm-51.8 {TkWmRestackToplevel procedure, overrideredirect windows} unix raise .t2 lappend result [winfo containing $x $y] } {.t2 .t .t2} -# The mac won't put an overrideredirect window above the root, -if {[tk windowingsystem] eq "aqua"} { - wm withdraw . - update -} -test unixWm-51.9 {TkWmRestackToplevel procedure, other window overrideredirect} unix { + +test unixWm-51.9 {TkWmRestackToplevel procedure, other window overrideredirect} -constraints unix -setup { + # The mac won't put an overrideredirect window above the root, + if {[tk windowingsystem] eq "aqua"} { + wm withdraw . + update + } +} -body { foreach w {.t .t2 .t3} { destroy $w update @@ -2122,11 +2230,12 @@ test unixWm-51.9 {TkWmRestackToplevel procedure, other window overrideredirect} lower .t2 update lappend result [winfo containing $x $y] -} {.t2 .t3} -if {[tk windowingsystem] eq "aqua"} { - wm deiconify . - update -} +} -cleanup { + if {[tk windowingsystem] eq "aqua"} { + wm deiconify . + update + } +} -result {.t2 .t3} test unixWm-51.10 {TkWmRestackToplevel procedure, don't move window that's already in the right place} unix { makeToplevels raise .raise1 @@ -2502,18 +2611,17 @@ test unixWm-59.3 {exit processing} unix { # NOTE: since [wm attributes] is not guaranteed to have any effect, # the only thing we can really test here is the syntax. # -if {[tk windowingsystem] eq "aqua"} { - set match_60_1 glob - set result_60_1 {-alpha 1.0 -appearance auto -buttons {close miniaturize zoom} -fullscreen 0 -isdark [01] -modified 0 -notify 0 -titlepath {} -topmost 0 -transparent 0 -stylemask {titled closable miniaturizable resizable} -class nswindow -tabbingid .t -tabbingmode auto -type unsupported} -} else { - set match_60_1 exact - set result_60_1 {-alpha 1.0 -fullscreen 0 -topmost 0 -type {} -zoomed 0} -} -test unixWm-60.1 {wm attributes - test} -constraints unix -body { +test unixWm-60.1.1 {wm attributes - test} -constraints {unix notAqua} -body { + destroy .t + toplevel .t + wm attributes .t +} -match exact -result {-alpha 1.0 -fullscreen 0 -topmost 0 -type {} -zoomed 0} + +test unixWm-60.1.2 {wm attributes - test} -constraints {unix aqua} -body { destroy .t toplevel .t wm attributes .t -} -match $match_60_1 -result $result_60_1 +} -match glob -result {-alpha 1.0 -appearance auto -buttons {close miniaturize zoom} -fullscreen 0 -isdark [01] -modified 0 -notify 0 -titlepath {} -topmost 0 -transparent 0 -stylemask {titled closable miniaturizable resizable} -class nswindow -tabbingid .t -tabbingmode auto -type unsupported} test unixWm-60.2 {wm attributes - test} -constraints unix -body { destroy .t @@ -2600,7 +2708,9 @@ test unixWm-62.4 {wm attributes -type list} -constraints unix -setup { destroy .t } -result {} -# cleanup +# +# TESTFILE CLEANUP +# + destroy .t cleanupTests -return |