diff options
Diffstat (limited to 'tests/unixWm.test')
| -rw-r--r-- | tests/unixWm.test | 168 |
1 files changed, 78 insertions, 90 deletions
diff --git a/tests/unixWm.test b/tests/unixWm.test index 28c8159..dd1aa22 100644 --- a/tests/unixWm.test +++ b/tests/unixWm.test @@ -2,9 +2,9 @@ # the window manager, including the "wm" command. It is organized # in the standard fashion for Tcl tests. # -# Copyright (c) 1992-1994 The Regents of the University of California. -# Copyright (c) 1994-1997 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright © 1992-1994 The Regents of the University of California. +# Copyright © 1994-1997 Sun Microsystems, Inc. +# Copyright © 1998-1999 by Scriptics Corporation. # All rights reserved. package require tcltest 2.2 @@ -13,22 +13,15 @@ tcltest::loadTestedCommands namespace import -force ::tk::test:loadTkCommand +testConstraint failsOnUbuntu [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}] +testConstraint failsOnXQuarz [expr {$tcl_platform(os) ne "Darwin" || [tk windowingsystem] ne "x11" }] + proc sleep ms { global x after $ms {set x 1} vwait x } -# The macOS window manager shows an animation when a window is deiconified. -# Tests which check the geometry of a window after deiconifying it should -# wait for the animation to finish. - - proc animationDelay {} { - if {[tk windowingsystem] == "aqua"} { - sleep 250 - } - } - # Procedure to set up a collection of top-level windows proc makeToplevels {} { @@ -46,9 +39,10 @@ proc makeToplevels {} { # larger than the height of the menubar (normally 23 pixels). if {[tk windowingsystem] eq "aqua"} { - set Y0 23 - set Y2 25 - set Y5 28 + set mb [expr [menubarheight] + 1] + set Y0 $mb + set Y2 [expr $mb + 2] + set Y5 [expr $mb + 5] } else { set Y0 0 set Y2 2 @@ -56,7 +50,7 @@ if {[tk windowingsystem] eq "aqua"} { } set i 1 -foreach geom "+23+80 +80+23 +0+$Y0" { +foreach geom "+$Y0+80 +80+$Y0 +0+$Y0" { destroy .t test unixWm-1.$i {initial window position} unix { toplevel .t -width 200 -height 150 @@ -82,7 +76,7 @@ update 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+23 +0+$Y0 -0-0 +0-0 -0+$Y0 -10-5 -10+$Y5 +10-5" { +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 update @@ -94,14 +88,14 @@ foreach geom "+20+80 +80+23 +0+$Y0 -0-0 +0-0 -0+$Y0 -10-5 -10+$Y5 +10-5" { } set i 1 -foreach geom "+20+80 +80+23 +0+$Y0 -0-0 +0-0 -0+$Y0 -10-5 -10+$Y5 +10-5" { +foreach geom "+20+80 +80+$Y0 +0+$Y0 -0-0 +0-0 -0+$Y0 -10-5 -10+$Y5 +10-5" { test unixWm-3.$i {moving window while iconified} unix { wm iconify .t - sleep 200 + update idletasks wm geom .t $geom - update + update idletasks wm deiconify .t - animationDelay + update idletasks scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y format "%s%d%s%d" $xsign [eval expr $x$xsign$xerr] $ysign \ [eval expr $y$ysign$yerr] @@ -113,11 +107,11 @@ set i 1 foreach geom "+20+80 +100+40 +0+$Y0" { test unixWm-4.$i {moving window while withdrawn} unix { wm withdraw .t - sleep 200 + update idletasks wm geom .t $geom - update + update idletasks wm deiconify .t - animationDelay + update idletasks wm geom .t } 100x150$geom incr i @@ -194,27 +188,27 @@ test unixWm-5.7 {compounded state changes} {unix nonPortable} { destroy .t toplevel .t -width 200 -height 100 -wm geom .t +10+23 +wm geom .t +10+$Y0 wm minsize .t 1 1 update test unixWm-6.1 {size changes} unix { .t config -width 180 -height 150 update wm geom .t -} 180x150+10+23 +} 180x150+10+$Y0 test unixWm-6.2 {size changes} unix { wm geom .t 250x60 .t config -width 170 -height 140 update wm geom .t -} 250x60+10+23 +} 250x60+10+$Y0 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+23 +} 170x140+10+$Y0 test unixWm-6.4 {size changes} {unix nonPortable userInteraction} { wm minsize .t 1 1 update @@ -296,11 +290,12 @@ test unixWm-8.3 {icon windows} unix { toplevel .t -width 100 -height 30 list [catch {wm iconwindow .t b c} msg] $msg } {1 {wrong # args: should be "wm iconwindow window ?pathName?"}} -test unixWm-8.4 {icon windows} unix { +test unixWm-8.4 {icon windows} {unix failsOnUbuntu} { destroy .t destroy .icon toplevel .t -width 100 -height 30 wm geom .t +0+0 + update idletasks set result [wm iconwindow .t] toplevel .icon -width 50 -height 50 -bg red wm iconwindow .t .icon @@ -310,7 +305,7 @@ test unixWm-8.4 {icon windows} unix { update lappend result [winfo ismapped .t] [winfo ismapped .icon] wm iconify .t - update + update idletasks lappend result [winfo ismapped .t] [winfo ismapped .icon] } {.icon icon {} withdrawn 1 0 0 0} test unixWm-8.5 {icon windows} unix { @@ -348,7 +343,6 @@ test unixWm-8.8 {icon windows} unix { wm geom .t +0+0 tkwait visibility .t ;# Needed to keep tvtwm happy. wm iconwindow .t .icon - sleep 500 lappend result [winfo ismapped .t] [winfo ismapped .icon] } {1 1 0} test unixWm-8.9 {icon windows} {unix nonPortable} { @@ -420,25 +414,23 @@ test unixWm-9.3 {TkWmMapWindow procedure, iconic windows} unix { toplevel .t -width 100 -height 300 -bg blue wm geom .t +0+0 wm iconify .t - sleep 500 winfo ismapped .t -} {0} +} 0 test unixWm-9.4 {TkWmMapWindow procedure, icon windows} unix { destroy .t - sleep 500 toplevel .t -width 100 -height 50 -bg blue tkwait visibility .t wm iconwindow . .t update set result [winfo ismapped .t] -} {0} +} 0 test unixWm-9.5 {TkWmMapWindow procedure, normal windows} unix { destroy .t toplevel .t -width 200 -height 20 wm geom .t +0+0 update winfo ismapped .t -} {1} +} 1 test unixWm-10.1 {TkWmDeadWindow procedure, canceling UpdateGeometry idle handler} unix { destroy .t @@ -643,7 +635,7 @@ test unixWm-16.2 {Tk_WmCmd procedure, "deiconify" option} unix { destroy .icon set result } {1 {can't deiconify .icon: it is an icon for .t}} -test unixWm-16.3 {Tk_WmCmd procedure, "deiconify" option} unix { +test unixWm-16.3 {Tk_WmCmd procedure, "deiconify" option} {unix failsOnUbuntu} { wm iconify .t set result {} lappend result [winfo ismapped .t] [wm state .t] @@ -672,7 +664,7 @@ test unixWm-18.1 {Tk_WmCmd procedure, "frame" option} unix { } {1 {wrong # args: should be "wm frame window"}} test unixWm-18.2 {Tk_WmCmd procedure, "frame" option} {unix nonPortable} { expr [wm frame .t] == [winfo id .t] -} {0} +} 0 test unixWm-18.3 {Tk_WmCmd procedure, "frame" option} {unix nonPortable} { destroy .t2 toplevel .t2 @@ -682,7 +674,7 @@ test unixWm-18.3 {Tk_WmCmd procedure, "frame" option} {unix nonPortable} { set result [expr [wm frame .t2] == [winfo id .t2]] destroy .t2 set result -} {1} +} 1 test unixWm-19.1 {Tk_WmCmd procedure, "geometry" option} unix { list [catch {wm geometry .t 12 13} msg] $msg @@ -793,7 +785,7 @@ test unixWm-21.4 {Tk_WmCmd procedure, "group" option, make window exist} {unix t set result [expr [testwrapper .t2] - [lindex $hints 8]] destroy .t2 set result -} {0} +} 0 test unixWm-21.5 {Tk_WmCmd procedure, "group" option, create leader wrapper} {unix testwrapper} { destroy .t2 destroy .t3 @@ -861,26 +853,26 @@ test unixWm-23.4 {Tk_WmCmd procedure, "iconify" option} unix { set result [list [catch {wm iconify .t2} msg] $msg] destroy .t2 set result -} {1 {can't iconify .t2: it is an icon for .t}} -test unixWm-23.5 {Tk_WmCmd procedure, "iconify" option} unix { +} {1 {can't iconify ".t2": it is an icon for ".t"}} +test unixWm-23.5 {Tk_WmCmd procedure, "iconify" option} {unix failsOnUbuntu} { destroy .t2 toplevel .t2 wm geom .t2 +0+0 - update + update idletasks wm iconify .t2 - update + update idletasks set result [winfo ismapped .t2] destroy .t2 set result -} {0} -test unixWm-23.6 {Tk_WmCmd procedure, "iconify" option} unix { +} 0 +test unixWm-23.6 {Tk_WmCmd procedure, "iconify" option} {unix failsOnUbuntu} { destroy .t2 toplevel .t2 wm geom .t2 -0+0 - update + update idletasks set result [winfo ismapped .t2] wm iconify .t2 - update + update idletasks lappend result [winfo ismapped .t2] destroy .t2 set result @@ -1309,7 +1301,7 @@ test unixWm-37.3 {Tk_WmCmd procedure, "transient" option} {unix testwrapper} { destroy .t2 set result } {{} {} .t 0 {} {}} -test unixWm-37.4 {TkWmDeadWindow, destroy on master should clear transient} {unix testwrapper} { +test unixWm-37.4 {TkWmDeadWindow, destroy on toplevel should clear transient} {unix testwrapper} { destroy .t2 toplevel .t2 destroy .t3 @@ -1320,7 +1312,7 @@ test unixWm-37.4 {TkWmDeadWindow, destroy on master should clear transient} {uni update list [wm transient .t2] [testprop [testwrapper .t2] WM_TRANSIENT_FOR] } {{} {}} -test unixWm-37.5 {Tk_WmCmd procedure, "transient" option, create master wrapper} {unix testwrapper} { +test unixWm-37.5 {Tk_WmCmd procedure, "transient" option, create toplevel wrapper} {unix testwrapper} { destroy .t2 destroy .t3 toplevel .t2 -width 120 -height 300 @@ -1384,12 +1376,13 @@ test unixWm-40.2 {Tk_SetGrid procedure, turning on grid when dimensions already test unixWm-41.1 {ConfigureEvent procedure, internally generated size changes} unix { destroy .t toplevel .t -width 400 -height 150 - wm geometry .t +0+0 tkwait visibility .t + wm geometry .t +0+0 + update idletasks set result {} lappend result [winfo width .t] [winfo height .t] .t configure -width 200 -height 300 - sleep 500 + update idletasks lappend result [winfo width .t] [winfo height .t] } {400 150 200 300} test unixWm-41.2 {ConfigureEvent procedure, menubars} {nonPortable testmenubar} { @@ -1443,7 +1436,7 @@ test unixWm-41.4 {ConfigureEvent procedure, synthesized Configure events} unix { # No tests for ReparentEvent or ComputeReparentGeometry; I can't figure # out how to exercise these procedures reliably. -test unixWm-42.1 {WrapperEventProc procedure, map and unmap events} unix { +test unixWm-42.1 {WrapperEventProc procedure, map and unmap events} {unix failsOnUbuntu} { destroy .t toplevel .t -width 400 -height 150 wm geometry .t +0+0 @@ -1453,11 +1446,11 @@ test unixWm-42.1 {WrapperEventProc procedure, map and unmap events} unix { bind .t <Unmap> {set x "unmapped"} set x {no event} wm iconify .t - animationDelay + update idletasks lappend result $x [winfo ismapped .t] set x {no event} wm deiconify .t - animationDelay + update idletasks lappend result $x [winfo ismapped .t] } {unmapped 0 mapped 1} @@ -1560,7 +1553,7 @@ test unixWm-44.6 {UpdateGeometryInfo procedure, negative height} unix { } {100 1} destroy .t toplevel .t -width 80 -height 60 -test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} unix { +test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} {unix failsOnXQuarz} { tkwait visibility .t wm overrideredirect .t 1 update @@ -1570,7 +1563,7 @@ test unixWm-44.7 {UpdateGeometryInfo procedure, computing position} unix { } [list 5 [expr [winfo screenheight .t] - 70]] destroy .t toplevel .t -width 80 -height 60 -test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} unix { +test unixWm-44.8 {UpdateGeometryInfo procedure, computing position} {unix failsOnXQuarz} { tkwait visibility .t wm overrideredirect .t 1 update @@ -1620,7 +1613,7 @@ test unixWm-45.1 {UpdateSizeHints procedure, grid information} {unix testwrapper [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} {unix testwrapper} { +test unixWm-45.2 {UpdateSizeHints procedure} {unix testwrapper failsOnUbuntu failsOnXQuarz} { destroy .t toplevel .t -width 80 -height 60 wm minsize .t 30 40 @@ -1648,7 +1641,7 @@ test unixWm-45.3 {UpdateSizeHints procedure, grid with menu} {testmenubar testwr [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} {testmenubar testwrapper} { +test unixWm-45.4 {UpdateSizeHints procedure, not resizable with menu} {testmenubar testwrapper failsOnUbuntu failsOnXQuarz} { destroy .t toplevel .t -width 80 -height 60 frame .t.menu -height 23 -width 50 @@ -1744,10 +1737,10 @@ test unixWm-48.10 {ParseGeometry procedure} unix { } {1 {bad geometry specifier "+20+10z"}} test unixWm-48.11 {ParseGeometry procedure} unix { catch {wm geometry .t +-10+20} -} {0} +} 0 test unixWm-48.12 {ParseGeometry procedure} unix { catch {wm geometry .t +30+-10} -} {0} +} 0 test unixWm-48.13 {ParseGeometry procedure, resize causes window to move} unix { destroy .t toplevel .t -width 200 -height 200 @@ -1802,7 +1795,7 @@ if {[tk windowingsystem] == "aqua"} { # Windows are assumed to have a border (invisible in Gnome 3). set result_50_1 {{} {} .t {} .t2 {} .t2 {} .t} } -test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords, title bar} unix { +test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords, title bar} {unix failsOnUbuntu failsOnXQuarz} { update toplevel .t -width 300 -height 400 -bg green wm geom .t +100+100 @@ -1850,7 +1843,7 @@ test unixWm-50.3 { Tk_CoordsToWindow procedure, finding a toplevel with embedding } tempNotWin { deleteWindows - catch {interp delete slave} + catch {interp delete child} toplevel .t -width 300 -height 400 -bg blue wm geom .t +100+100 @@ -1858,10 +1851,10 @@ test unixWm-50.3 { place .t.f -x 150 -y 50 tkwait visibility .t.f update - interp create slave - load {} Tk slave - slave alias frameid winfo id .t.f - slave eval { + interp create child + load {} Tk child + child alias frameid winfo id .t.f + child eval { wm withdraw . toplevel .x -width 100 -height 80 -use [frameid] -bg yellow tkwait visibility .x @@ -1869,9 +1862,9 @@ test unixWm-50.3 { set x [winfo rootx .x] set y [winfo rooty .x] } - set result [list [slave eval {winfo containing [expr $x - 1] [expr $y + 50]}] \ - [slave eval {winfo containing $x [expr $y + 50]}]] - interp delete slave + set result [list [child eval {winfo containing [expr $x - 1] [expr $y + 50]}] \ + [child eval {winfo containing $x [expr $y + 50]}]] + interp delete child set x [winfo rootx .t] set y [winfo rooty .t] lappend result [winfo containing [expr $x + 200] [expr $y + 49]] \ @@ -1881,17 +1874,17 @@ test unixWm-50.3 { test unixWm-50.4 {Tk_CoordsToWindow procedure, window in other application} unix { destroy .t - catch {interp delete slave} + catch {interp delete child} toplevel .t -width 200 -height 200 -bg green wm geometry .t +100+100 tkwait visibility .t update - interp create slave - load {} Tk slave - slave eval {wm geometry . 200x200+100+100; tkwait visibility . ; update} + interp create child + load {} Tk child + child eval {wm geometry . 200x200+100+100; tkwait visibility . ; update} set result [list [winfo containing 200 200] \ - [slave eval {winfo containing 200 200}]] - interp delete slave + [child eval {winfo containing 200 200}]] + interp delete child set result } {{} .} test unixWm-50.5 {Tk_CoordsToWindow procedure, handling menubars} {unix testmenubar} { @@ -1953,13 +1946,13 @@ test unixWm-50.7 {Tk_CoordsToWindow procedure, more basics} unix { test unixWm-50.8 {Tk_CoordsToWindow procedure, more basics} unix { destroy .t toplevel .t -width 400 -height 300 -bg green - wm geom .t +0+0 + wm geom .t +0+30 frame .t.f -width 200 -height 100 -bd 2 -relief raised place .t.f -x 100 -y 100 frame .t.f.f -width 200 -height 100 -bd 2 -relief raised place .t.f.f -x 100 -y 0 update - set x [winfo rooty .t] + set x [winfo rootx .t] set y [expr [winfo rooty .t] + 150] list [winfo containing [expr $x + 50] $y] \ [winfo containing [expr $x + 150] $y] \ @@ -1967,10 +1960,9 @@ test unixWm-50.8 {Tk_CoordsToWindow procedure, more basics} unix { [winfo containing [expr $x + 350] $y] \ [winfo containing [expr $x + 450] $y] } {.t .t.f .t.f.f .t {}} -test unixWm-50.9 {Tk_CoordsToWindow procedure, unmapped windows} unix { +test unixWm-50.9 {Tk_CoordsToWindow procedure, unmapped windows} {unix failsOnUbuntu} { destroy .t destroy .t2 - sleep 500 ;# Give window manager time to catch up. toplevel .t -width 200 -height 200 -bg green wm geometry .t +0+0 tkwait visibility .t @@ -1979,7 +1971,7 @@ test unixWm-50.9 {Tk_CoordsToWindow procedure, unmapped windows} unix { tkwait visibility .t2 set result [list [winfo containing 100 100]] wm iconify .t2 - animationDelay + update idletasks lappend result [winfo containing 100 100] } {.t2 .t} test unixWm-50.10 {Tk_CoordsToWindow procedure, unmapped windows} unix { @@ -1989,9 +1981,10 @@ test unixWm-50.10 {Tk_CoordsToWindow procedure, unmapped windows} unix { frame .t.f -width 150 -height 150 -bd 2 -relief raised place .t.f -x 25 -y 25 tkwait visibility .t.f + update idletasks set result [list [winfo containing 100 100]] place forget .t.f - update + update idletasks lappend result [winfo containing 100 100] } {.t.f .t} deleteWindows @@ -2021,7 +2014,6 @@ test unixWm-51.3 {TkWmRestackToplevel procedure, basic tests} {unix nonPortable} set result [winfo containing [winfo rootx .raise1] \ [winfo rooty .raise1]] destroy .raise2 - sleep 500 list $result [winfo containing [winfo rootx .raise1] \ [winfo rooty .raise1]] } {.raise2 .raise1} @@ -2032,7 +2024,6 @@ test unixWm-51.4 {TkWmRestackToplevel procedure, basic tests} {unix nonPortable} lower .raise3 .raise1 set result [winfo containing 100 100] destroy .raise1 - sleep 500 lappend result [winfo containing 100 100] } {.raise1 .raise3} test unixWm-51.5 {TkWmRestackToplevel procedure, basic tests} {unix nonPortable} { @@ -2047,7 +2038,6 @@ test unixWm-51.5 {TkWmRestackToplevel procedure, basic tests} {unix nonPortable} set result [winfo containing [winfo rootx .raise1] \ [winfo rooty .raise1]] destroy .raise1 - sleep 500 list $result [winfo containing [winfo rootx .raise2] \ [winfo rooty .raise2]] } {.raise1 .raise3} @@ -2062,7 +2052,7 @@ test unixWm-51.6 {TkWmRestackToplevel procedure, window to be stacked isn't mapp wm geometry .t2 +0+0 winfo containing 100 100 } {.t} -test unixWm-51.7 {TkWmRestackToplevel procedure, other window isn't mapped} unix { +test unixWm-51.7 {TkWmRestackToplevel procedure, other window isn't mapped} {unix failsOnXQuarz} { foreach w {.t .t2 .t3} { destroy $w update @@ -2070,11 +2060,9 @@ test unixWm-51.7 {TkWmRestackToplevel procedure, other window isn't mapped} unix wm geometry $w +0+0 } raise .t .t2 - sleep 2000 update set result [list [winfo containing 100 100]] lower .t3 - sleep 2000 lappend result [winfo containing 100 100] } {.t3 .t} test unixWm-51.8 {TkWmRestackToplevel procedure, overrideredirect windows} unix { @@ -2250,7 +2238,7 @@ test unixWm-54.2 {TkpMakeMenuWindow procedure, setting override_redirect} {unix set result [wm overrideredirect .m] destroy .m set result -} {1} +} 1 # No tests for TkGetPointerCoords, CreateWrapper, or GetMaxSize. |