summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2019-01-10 11:39:31 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2019-01-10 11:39:31 (GMT)
commitff3492bbc800f6cb8529315fc531339acef43fb4 (patch)
tree88a1aa87c3b869e363e04c8b2f5e2357d9e97f43 /tests
parent1fd3bd358e8df3bb28729eb43824fff9ecf50ec5 (diff)
parent587df2a3c0d221979267d8549003fa2dda184a38 (diff)
downloadtk-ff3492bbc800f6cb8529315fc531339acef43fb4.zip
tk-ff3492bbc800f6cb8529315fc531339acef43fb4.tar.gz
tk-ff3492bbc800f6cb8529315fc531339acef43fb4.tar.bz2
Merge 8.6
Diffstat (limited to 'tests')
-rw-r--r--tests/text.test221
-rw-r--r--tests/unixWm.test200
-rw-r--r--tests/wm.test31
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