diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2019-01-10 11:39:31 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2019-01-10 11:39:31 (GMT) |
commit | ff3492bbc800f6cb8529315fc531339acef43fb4 (patch) | |
tree | 88a1aa87c3b869e363e04c8b2f5e2357d9e97f43 /tests | |
parent | 1fd3bd358e8df3bb28729eb43824fff9ecf50ec5 (diff) | |
parent | 587df2a3c0d221979267d8549003fa2dda184a38 (diff) | |
download | tk-ff3492bbc800f6cb8529315fc531339acef43fb4.zip tk-ff3492bbc800f6cb8529315fc531339acef43fb4.tar.gz tk-ff3492bbc800f6cb8529315fc531339acef43fb4.tar.bz2 |
Merge 8.6
Diffstat (limited to 'tests')
-rw-r--r-- | tests/text.test | 221 | ||||
-rw-r--r-- | tests/unixWm.test | 200 | ||||
-rw-r--r-- | tests/wm.test | 31 |
3 files changed, 272 insertions, 180 deletions
diff --git a/tests/text.test b/tests/text.test index 988417e..aaddc2c 100644 --- a/tests/text.test +++ b/tests/text.test @@ -2936,11 +2936,13 @@ test text-11a.1 {TextWidgetCmd procedure, "pendingsync" option} -setup { } -cleanup { destroy .yt } -result {1 {wrong # args: should be ".yt pendingsync"}} + test text-11a.2 {TextWidgetCmd procedure, "pendingsync" option} -setup { destroy .top.yt .top } -body { toplevel .top pack [text .top.yt] + update set content {} for {set i 1} {$i < 300} {incr i} { append content [string repeat "$i " 15] \n @@ -2978,9 +2980,11 @@ test text-11a.12 {TextWidgetCmd procedure, "sync" option} -setup { } -body { toplevel .top pack [text .top.yt] + update set content {} + # Use long lines so the line metrics will need updating. for {set i 1} {$i < 30} {incr i} { - append content [string repeat "$i " 15] \n + append content [string repeat "$i " 200] \n } .top.yt insert 1.0 $content # wait for end of line metrics calculation to get correct $fraction1 @@ -3053,19 +3057,18 @@ test text-11a.31 {"<<WidgetViewSync>>" event} -setup { for {set i 1} {$i < 300} {incr i} { append content [string repeat "$i " 15] \n } - .top.yt insert 1.0 $content + # Sync the widget and process <<WidgetViewSync>> events before binding. + .top.yt sync update bind .top.yt <<WidgetViewSync>> { if {%d} {set yud(%W) 1} } - # wait for end of line metrics calculation to get correct $fraction1 - # as a reference - if {[.top.yt pendingsync]} {vwait yud(.top.yt)} + .top.yt insert 1.0 $content .top.yt yview moveto 1 set fraction1 [lindex [.top.yt yview] 0] set res [expr {$fraction1 > 0}] .top.yt delete 1.0 end .top.yt insert 1.0 $content # synchronously wait for completion of line metrics calculation - # and ensure the test is relevant + # and verify that the fractions agree. set waited 0 if {[.top.yt pendingsync]} {set waited 1 ; vwait yud(.top.yt)} lappend res $waited @@ -3079,7 +3082,6 @@ test text-11a.31 {"<<WidgetViewSync>>" event} -setup { test text-11a.41 {"sync" "pendingsync" and <<WidgetViewSync>>} -setup { destroy .top.yt .top } -body { - set res {} toplevel .top pack [text .top.yt] update @@ -3087,15 +3089,21 @@ test text-11a.41 {"sync" "pendingsync" and <<WidgetViewSync>>} -setup { for {set i 1} {$i < 300} {incr i} { append content [string repeat "$i " 50] \n } + # Sync the widget and process all <<WidgetViewSync>> events before binding. + .top.yt sync + update bind .top.yt <<WidgetViewSync>> {lappend res Sync:%d} + set res {} + # The next line triggers <<WidgetViewSync>> with %d==0 i.e. out of sync. .top.yt insert 1.0 $content - vwait res ; # event dealt with by the event loop, with %d==0 i.e. we're out of sync - # ensure the test is relevant + vwait res + # Verify that the line metrics are not up-to-date (pendingsync is 1). lappend res "Pending:[.top.yt pendingsync]" - # - <<WidgetViewSync>> fires when sync returns if there was pending syncs - # - there is no more any pending sync after running 'sync' + # Update all line metrics by calling the sync command. .top.yt sync - vwait res ; # event dealt with by the event loop, with %d==1 i.e. we're in sync again + # <<WidgetViewSync>> should fire with %d==1 i.e. back in sync. + vwait res + # At this time the line metrics should be up-to-date (pendingsync is 0). lappend res "Pending:[.top.yt pendingsync]" set res } -cleanup { @@ -3110,6 +3118,7 @@ test text-11a.51 {<<WidgetViewSync>> calls TkSendVirtualEvent(), set res {} toplevel .top pack [text .top.t] + update for {set i 1} {$i < 10000} {incr i} { .top.t insert end "Hello world!\n" } @@ -7356,6 +7365,100 @@ test text-32.1 {line heights on creation} -setup { destroy .t } -result {1} +test text-32.2 {peer widget -start, -end and deletion (bug 1630262)} -setup { + destroy .t .pt + set res {} +} -body { + text .t + .t peer create .pt + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + .t configure -startline 5 + # none of the following delete shall crash + # (all did before fixing bug 1630262) + # 1. delete on the same line: line1 == line2 in DeleteIndexRange, + # and resetView is true neither for .t not for .pt + .pt delete 2.0 2.2 + # 2. delete just one line: line1 < line2 in DeleteIndexRange, + # and resetView is true only for .t, not for .pt + .pt delete 2.0 3.0 + # 3. delete several lines: line1 < line2 in DeleteIndexRange, + # and resetView is true only for .t, not for .pt + .pt delete 2.0 5.0 + # 4. delete to the end line: line1 < line2 in DeleteIndexRange, + # and resetView is true only for .t, not for .pt + .pt delete 2.0 end + # this test succeeds provided there is no crash + set res 1 +} -cleanup { + destroy .pt +} -result {1} + +test text-32.3 {peer widget -start, -end and deletion (bug 1630262)} -setup { + destroy .t .pt + set res {} +} -body { + text .t + .t peer create .pt + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + .t configure -startline 5 + .pt configure -startline 3 + # the following delete shall not crash + # (it did before fixing bug 1630262) + .pt delete 2.0 3.0 + # moreover -startline shall be correct + # (was wrong before fixing bug 1630262) + lappend res [.t cget -start] [.pt cget -start] +} -cleanup { + destroy .pt +} -result {4 3} + +test text-32.4 {peer widget -start, -end and deletion (bug 1630262)} -setup { + destroy .t .pt + set res {} +} -body { + text .t + .t peer create .pt + for {set i 1} {$i < 100} {incr i} { + .t insert end "Line $i\n" + } + .t configure -startline 5 -endline 15 + .pt configure -startline 8 -endline 12 + # .pt now shows a range entirely inside the range of .pt + # from .t, delete lines located after [.pt cget -end] + .t delete 9.0 10.0 + # from .t, delete lines straddling [.pt cget -end] + .t delete 6.0 9.0 + lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end] + .t configure -startline 5 -endline 12 + .pt configure -startline 8 -endline 12 + # .pt now shows again a range entirely inside the range of .pt + # from .t, delete lines located before [.pt cget -start] + .t delete 2.0 3.0 + # from .t, delete lines straddling [.pt cget -start] + .t delete 2.0 5.0 + lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end] + .t configure -startline 22 -endline 31 + .pt configure -startline 42 -endline 51 + # .t now shows a range entirely before the range of .pt + # from .t, delete some lines, then do it from .pt + .t delete 2.0 3.0 + .t delete 2.0 5.0 + .pt delete 2.0 5.0 + lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end] + .t configure -startline 55 -endline 75 + .pt configure -startline 60 -endline 70 + # .pt now shows a range entirely inside the range of .t + # from .t, delete a range straddling the entire range of .pt + .t delete 3.0 18.0 + lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end] +} -cleanup { + destroy .pt .t +} -result {5 11 8 10 5 8 6 8 22 27 38 44 55 60 57 57} + test text-33.1 {TextWidgetCmd procedure, "peer" option} -setup { text .t @@ -7488,100 +7591,6 @@ test text-34.1 {peer widget -start, -end and selection} -setup { destroy .t } -result {{10.0 20.0} {6.0 16.0} {6.0 11.0} {1.0 6.0} {1.0 2.0} {} {10.0 20.0}} -test text-32.2 {peer widget -start, -end and deletion (bug 1630262)} -setup { - destroy .t .pt - set res {} -} -body { - text .t - .t peer create .pt - for {set i 1} {$i < 100} {incr i} { - .t insert end "Line $i\n" - } - .t configure -startline 5 - # none of the following delete shall crash - # (all did before fixing bug 1630262) - # 1. delete on the same line: line1 == line2 in DeleteIndexRange, - # and resetView is true neither for .t not for .pt - .pt delete 2.0 2.2 - # 2. delete just one line: line1 < line2 in DeleteIndexRange, - # and resetView is true only for .t, not for .pt - .pt delete 2.0 3.0 - # 3. delete several lines: line1 < line2 in DeleteIndexRange, - # and resetView is true only for .t, not for .pt - .pt delete 2.0 5.0 - # 4. delete to the end line: line1 < line2 in DeleteIndexRange, - # and resetView is true only for .t, not for .pt - .pt delete 2.0 end - # this test succeeds provided there is no crash - set res 1 -} -cleanup { - destroy .pt -} -result {1} - -test text-32.3 {peer widget -start, -end and deletion (bug 1630262)} -setup { - destroy .t .pt - set res {} -} -body { - text .t - .t peer create .pt - for {set i 1} {$i < 100} {incr i} { - .t insert end "Line $i\n" - } - .t configure -startline 5 - .pt configure -startline 3 - # the following delete shall not crash - # (it did before fixing bug 1630262) - .pt delete 2.0 3.0 - # moreover -startline shall be correct - # (was wrong before fixing bug 1630262) - lappend res [.t cget -start] [.pt cget -start] -} -cleanup { - destroy .pt -} -result {4 3} - -test text-32.4 {peer widget -start, -end and deletion (bug 1630262)} -setup { - destroy .t .pt - set res {} -} -body { - text .t - .t peer create .pt - for {set i 1} {$i < 100} {incr i} { - .t insert end "Line $i\n" - } - .t configure -startline 5 -endline 15 - .pt configure -startline 8 -endline 12 - # .pt now shows a range entirely inside the range of .pt - # from .t, delete lines located after [.pt cget -end] - .t delete 9.0 10.0 - # from .t, delete lines straddling [.pt cget -end] - .t delete 6.0 9.0 - lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end] - .t configure -startline 5 -endline 12 - .pt configure -startline 8 -endline 12 - # .pt now shows again a range entirely inside the range of .pt - # from .t, delete lines located before [.pt cget -start] - .t delete 2.0 3.0 - # from .t, delete lines straddling [.pt cget -start] - .t delete 2.0 5.0 - lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end] - .t configure -startline 22 -endline 31 - .pt configure -startline 42 -endline 51 - # .t now shows a range entirely before the range of .pt - # from .t, delete some lines, then do it from .pt - .t delete 2.0 3.0 - .t delete 2.0 5.0 - .pt delete 2.0 5.0 - lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end] - .t configure -startline 55 -endline 75 - .pt configure -startline 60 -endline 70 - # .pt now shows a range entirely inside the range of .t - # from .t, delete a range straddling the entire range of .pt - .t delete 3.0 18.0 - lappend res [.t cget -start] [.t cget -end] [.pt cget -start] [.pt cget -end] -} -cleanup { - destroy .pt .t -} -result {5 11 8 10 5 8 6 8 22 27 38 44 55 60 57 57} - test text-35.1 {widget dump -command alters tags} -setup { proc Dumpy {key value index} { #puts "KK: $key, $value" diff --git a/tests/unixWm.test b/tests/unixWm.test index d579fc7..12a2142 100644 --- a/tests/unixWm.test +++ b/tests/unixWm.test @@ -19,6 +19,16 @@ proc sleep ms { 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 {} { @@ -76,6 +86,7 @@ foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} { wm geom .t $geom update wm deiconify .t + animationDelay 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] @@ -91,6 +102,7 @@ foreach geom {+20+80 +100+40 +0+0} { wm geom .t $geom update wm deiconify .t + animationDelay wm geom .t } 100x150$geom incr i @@ -400,6 +412,7 @@ 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] @@ -795,9 +808,15 @@ test unixWm-22.2 {Tk_WmCmd procedure, "iconbitmap" option} {unix testwrapper} { WM_HINTS] 0]]] lappend result [wm iconbitmap .t] $bit } {{} questhead 0x4 {} 0x0} -test unixWm-22.3 {Tk_WmCmd procedure, "iconbitmap" option} unix { +if {[tk windowingsystem] == "aqua"} { + set result_22_3 {0 {}} +} else { + set result_22_3 {1 {bitmap "bad-bitmap" not defined}} +} +test unixWm-22.3 {Tk_WmCmd procedure, "iconbitmap" option for unix only} \ +unix { list [catch {wm iconbitmap .t bad-bitmap} msg] $msg -} {1 {bitmap "bad-bitmap" not defined}} +} $result_22_3 test unixWm-23.1 {Tk_WmCmd procedure, "iconify" option} unix { list [catch {wm iconify .t 12} msg] $msg @@ -1200,10 +1219,14 @@ 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}} - -test unixWm-35.1 {Tk_WmCmd procedure, "state" option} unix { +if {[tk windowingsystem] == "aqua"} { + set result_35_1 {1 {bad argument "1": must be normal, iconic, withdrawn, or zoomed}} +} else { + set result_35_1 {1 {bad argument "1": must be normal, iconic, or withdrawn}} +} +test unixWm-35.1 {Tk_WmCmd procedure, "state" option} {unix notAqua} { list [catch {wm state .t 1} msg] $msg -} {1 {bad argument "1": must be normal, iconic, or withdrawn}} +} $result_35_1 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?"}} @@ -1415,9 +1438,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 lappend result $x [winfo ismapped .t] set x {no event} wm deiconify .t + animationDelay lappend result $x [winfo ismapped .t] } {unmapped 0 mapped 1} @@ -1507,9 +1532,9 @@ 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 { - destroy .t - toplevel .t -width 80 -height 60 wm grid .t 18 7 10 12 wm geometry .t +30+40 wm overrideredirect .t 1 @@ -1518,22 +1543,24 @@ test unixWm-44.6 {UpdateGeometryInfo procedure, negative height} unix { 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 { - wm geometry .t +5-10 - wm overrideredirect .t 1 tkwait visibility .t + wm overrideredirect .t 1 + 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 { - wm geometry .t -30+2 - wm overrideredirect .t 1 tkwait visibility .t + wm overrideredirect .t 1 + update + wm geometry .t -30+2 + update list [winfo x .t] [winfo y .t] } [list [expr [winfo screenwidth .t] - 110] 2] destroy .t @@ -1752,88 +1779,103 @@ test unixWm-49.2 {Tk_GetRootCoords procedure, menubars} {unix testmenubar} { } {52 7 12 62} deleteWindows -wm iconify . -test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords} unix { - deleteWindows +wm withdraw . +if {[tk windowingsystem] == "aqua"} { + # Modern mac windows have no border. + set result_50_1 {{} {} .t .t .t2 {} .t2 .t .t} +} else { + # 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 { + update toplevel .t -width 300 -height 400 -bg green - wm geom .t +40+0 + wm geom .t +100+100 tkwait visibility .t - toplevel .t2 -width 100 -height 80 -bg red - wm geom .t2 +140+200 + toplevel .t2 -width 100 -height 200 -bg red + wm geom .t2 +200+200 tkwait visibility .t2 raise .t2 + update set x [winfo rootx .t] set y [winfo rooty .t] - list [winfo containing [expr $x - 30] [expr $y + 250]] \ - [winfo containing [expr $x - 1] [expr $y + 250]] \ - [winfo containing $x [expr $y + 250]] \ - [winfo containing [expr $x + 99] [expr $y + 250]] \ - [winfo containing [expr $x + 100] [expr $y + 250]] \ - [winfo containing [expr $x + 199] [expr $y + 250]] \ - [winfo containing [expr $x + 200] [expr $y + 250]] \ - [winfo containing [expr $x + 220] [expr $y + 250]] -} {{} {} .t {} .t2 .t2 {} .t} + list [winfo containing [expr $x - 30] [expr $y + 250]] \ + [winfo containing [expr $x - 1] [expr $y + 250]] \ + [winfo containing $x [expr $y + 250]] \ + [winfo containing [expr $x + 99] [expr $y + 250]] \ + [winfo containing [expr $x + 100] [expr $y + 250]] \ + [winfo containing [expr $x + 150] [expr $y + 90]] \ + [winfo containing [expr $x + 199] [expr $y + 250]] \ + [winfo containing [expr $x + 200] [expr $y + 250]] \ + [winfo containing [expr $x + 220] [expr $y + 250]] \ +} $result_50_1 test unixWm-50.2 {Tk_CoordsToWindow procedure, finding a toplevel, y-coords and overrideredirect} unix { deleteWindows - toplevel .t -width 300 -height 400 -bg yellow - wm geom .t +0+50 + toplevel .t -width 400 -height 300 -bg yellow + wm geom .t +100+100 tkwait visibility .t - toplevel .t2 -width 100 -height 80 -bg blue + toplevel .t2 -width 200 -height 100 -bg blue wm overrideredirect .t2 1 - wm geom .t2 +100+200 + wm geom .t2 +200+200 tkwait visibility .t2 raise .t2 set x [winfo rootx .t] set y [winfo rooty .t] set y2 [winfo rooty .t2] - list [winfo containing [expr $x +150] 10] \ - [winfo containing [expr $x +150] [expr $y - 1]] \ - [winfo containing [expr $x +150] $y] \ - [winfo containing [expr $x +150] [expr $y2 - 1]] \ - [winfo containing [expr $x +150] $y2] \ - [winfo containing [expr $x +150] [expr $y2 + 79]] \ - [winfo containing [expr $x +150] [expr $y2 + 80]] \ - [winfo containing [expr $x +150] [expr $y + 450]] + list [winfo containing [expr $x +200] [expr $y - 30]] \ + [winfo containing [expr $x +200] [expr $y - 1]] \ + [winfo containing [expr $x +200] $y] \ + [winfo containing [expr $x +200] [expr $y2 - 1]] \ + [winfo containing [expr $x +200] $y2] \ + [winfo containing [expr $x +200] [expr $y2 + 99]] \ + [winfo containing [expr $x +200] [expr $y2 + 100]] \ + [winfo containing [expr $x +200] [expr $y + 450]] } {{} {} .t .t .t2 .t2 .t {}} test unixWm-50.3 { Tk_CoordsToWindow procedure, finding a toplevel with embedding -} -constraints tempNotWin -setup { +} tempNotWin { deleteWindows + catch {interp delete slave} + toplevel .t -width 300 -height 400 -bg blue - wm geom .t +0+50 - frame .t.f -container 1 + wm geom .t +100+100 + frame .t.f -container 1 -bg red place .t.f -x 150 -y 50 tkwait visibility .t.f - setupbg -} -body { - dobg " + update + interp create slave + load {} Tk slave + slave alias frameid winfo id .t.f + slave eval { wm withdraw . - toplevel .x -width 100 -height 80 -use [winfo id .t.f] -bg yellow - tkwait visibility .x" - set result [dobg { - set x [winfo rootx .x] - set y [winfo rooty .x] - list [winfo containing [expr $x - 1] [expr $y + 50]] \ - [winfo containing $x [expr $y +50]] - }] + toplevel .x -width 100 -height 80 -use [frameid] -bg yellow + tkwait visibility .x + update + 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 x [winfo rootx .t] set y [winfo rooty .t] lappend result [winfo containing [expr $x + 200] [expr $y + 49]] \ - [winfo containing [expr $x + 200] [expr $y +50]] -} -cleanup { - cleanupbg -} -result {{} .x .t .t.f} + [winfo containing [expr $x + 200] [expr $y +50]] + set result +} {{} .x .t .t.f} test unixWm-50.4 {Tk_CoordsToWindow procedure, window in other application} unix { destroy .t + catch {interp delete slave} toplevel .t -width 200 -height 200 -bg green - wm geometry .t +0+0 + wm geometry .t +100+100 tkwait visibility .t + update interp create 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}]] + slave 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 set result } {{} .} @@ -1851,13 +1893,13 @@ test unixWm-50.5 {Tk_CoordsToWindow procedure, handling menubars} {unix testmenu update set x [winfo rootx .t] set y [winfo rooty .t] - list [winfo containing $x [expr $y - 31]] \ - [winfo containing $x [expr $y - 30]] \ - [winfo containing [expr $x + 50] [expr $y - 19]] \ - [winfo containing [expr $x + 50] [expr $y - 18]] \ - [winfo containing [expr $x + 50] $y] \ - [winfo containing [expr $x + 11] [expr $y + 152]] \ - [winfo containing [expr $x + 12] [expr $y + 152]] + list [winfo containing $x [expr $y - 31]] \ + [winfo containing $x [expr $y - 30]] \ + [winfo containing [expr $x + 50] [expr $y - 19]] \ + [winfo containing [expr $x + 50] [expr $y - 18]] \ + [winfo containing [expr $x + 50] $y] \ + [winfo containing [expr $x + 11] [expr $y + 152]] \ + [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.} unix { deleteWindows @@ -1922,6 +1964,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 lappend result [winfo containing 100 100] } {.t2 .t} test unixWm-50.10 {Tk_CoordsToWindow procedure, unmapped windows} unix { @@ -2007,6 +2050,7 @@ test unixWm-51.6 {TkWmRestackToplevel procedure, window to be stacked isn't mapp test unixWm-51.7 {TkWmRestackToplevel procedure, other window isn't mapped} unix { foreach w {.t .t2 .t3} { destroy $w + update toplevel $w -width 200 -height 200 -bg green wm geometry $w +0+0 } @@ -2043,13 +2087,19 @@ 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] == "aqua"} { + wm withdraw . +} test unixWm-51.9 {TkWmRestackToplevel procedure, other window overrideredirect} unix { foreach w {.t .t2 .t3} { destroy $w + update toplevel $w -width 200 -height 200 -bg green wm overrideredirect $w 1 wm geometry $w +0+0 tkwait visibility $w + update } lower .t3 .t2 update @@ -2065,6 +2115,9 @@ test unixWm-51.9 {TkWmRestackToplevel procedure, other window overrideredirect} lower .t2 lappend result [winfo containing $x $y] } {.t2 .t3} +if {[tk windowingsystem] == "aqua"} { + wm deiconify . +} test unixWm-51.10 {TkWmRestackToplevel procedure, don't move window that's already in the right place} unix { makeToplevels raise .raise1 @@ -2440,11 +2493,18 @@ 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] == "aqua"} { + set result_60_1 {-alpha 1.0 -fullscreen 0 -modified 0 -notify 0\ + -titlepath {} -topmost 0 -transparent 0\ + -type unsupported} +} else { + set result_60_1 {-alpha 1.0 -topmost 0 -zoomed 0 -fullscreen 0 -type {}} +} test unixWm-60.1 {wm attributes - test} -constraints unix -body { destroy .t toplevel .t wm attributes .t -} -result [list -alpha 1.0 -topmost 0 -zoomed 0 -fullscreen 0 -type {}] +} -result $result_60_1 test unixWm-60.2 {wm attributes - test} -constraints unix -body { destroy .t diff --git a/tests/wm.test b/tests/wm.test index 9cbe49a..7b81985 100644 --- a/tests/wm.test +++ b/tests/wm.test @@ -140,7 +140,7 @@ test wm-attributes-1.2.4 {usage} -constraints {unix notAqua} -returnCodes error } -result {bad attribute "_": must be -alpha, -topmost, -zoomed, -fullscreen, or -type} test wm-attributes-1.2.5 {usage} -constraints aqua -returnCodes error -body { wm attributes . _ -} -result {bad attribute "_": must be -alpha, -fullscreen, -modified, -notify, -titlepath, -topmost, or -transparent} +} -result {bad attribute "_": must be -alpha, -fullscreen, -modified, -notify, -titlepath, -topmost, -transparent, or -type} ### wm client ### @@ -1516,9 +1516,10 @@ test wm-stackorder-5.1 {a menu is not a toplevel} -body { } -cleanup { destroy .t } -result {.t .} -test wm-stackorder-5.2 {A normal toplevel can't be\ - raised above an overrideredirect toplevel} -body { +test wm-stackorder-5.2 {A normal toplevel can't be raised above an \ + overrideredirect toplevel on unix} -constraints x11 -body { toplevel .t + tkwait visibility .t wm overrideredirect .t 1 raise . update @@ -1527,9 +1528,22 @@ test wm-stackorder-5.2 {A normal toplevel can't be\ } -cleanup { destroy .t } -result 0 +test wm-stackorder-5.2.1 {A normal toplevel can be raised above an \ + overrideredirect toplevel on macOS or win} -constraints aquaOrWin32 -body { + toplevel .t + tkwait visibility .t + wm overrideredirect .t 1 + raise . + update + raiseDelay + wm stackorder . isabove .t +} -cleanup { + destroy .t +} -result 1 test wm-stackorder-5.3 {An overrideredirect window\ can be explicitly lowered} -body { toplevel .t + tkwait visibility .t wm overrideredirect .t 1 lower .t update @@ -1540,7 +1554,7 @@ test wm-stackorder-5.3 {An overrideredirect window\ } -result 1 test wm-stackorder-6.1 {An embedded toplevel does not\ - appear in the stacking order} -body { + appear in the stacking order on unix or win} -constraints notAqua -body { toplevel .real -container 1 toplevel .embd -bg blue -use [winfo id .real] update @@ -1548,6 +1562,15 @@ test wm-stackorder-6.1 {An embedded toplevel does not\ } -cleanup { deleteWindows } -result {. .real} +test wm-stackorder-6.1.1 {An embedded toplevel does\ + appear in the stacking order on macOS} -constraints aqua -body { + toplevel .real -container 1 + toplevel .embd -bg blue -use [winfo id .real] + update + wm stackorder . +} -cleanup { + deleteWindows +} -result {. .embd} stdWindow |