summaryrefslogtreecommitdiffstats
path: root/tests/event.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/event.test')
-rw-r--r--tests/event.test425
1 files changed, 370 insertions, 55 deletions
diff --git a/tests/event.test b/tests/event.test
index c56d4d8..3cef258 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -51,17 +51,17 @@ proc _keypress_lookup {char} {
global keypress_lookup
if {! [info exists keypress_lookup]} {
- _init_keypress_lookup
+ _init_keypress_lookup
}
if {$char == ""} {
- error "empty char"
+ error "empty char"
}
if {[info exists keypress_lookup($char)]} {
- return $keypress_lookup($char)
+ return $keypress_lookup($char)
} else {
- return $char
+ return $char
}
}
@@ -76,12 +76,12 @@ proc _keypress {win key} {
# the focus if the mouse is moved around.
if {[focus] != $win} {
- focus -force $win
+ focus -force $win
}
event generate $win <Key-$keysym>
_pause 50
if {[focus] != $win} {
- focus -force $win
+ focus -force $win
}
event generate $win <KeyRelease-$keysym>
_pause 50
@@ -91,7 +91,7 @@ proc _keypress {win key} {
proc _keypress_string {win string} {
foreach letter [split $string ""] {
- _keypress $win $letter
+ _keypress $win $letter
}
}
@@ -101,7 +101,7 @@ proc _pause {{msecs 1000}} {
global _pause
if {! [info exists _pause(number)]} {
- set _pause(number) 0
+ set _pause(number) 0
}
set num [incr _pause(number)]
@@ -117,7 +117,7 @@ proc _pause {{msecs 1000}} {
proc _text_ind_to_x_y {text ind} {
set bbox [$text bbox $ind]
if {[llength $bbox] != 4} {
- error "got bbox \{$bbox\} from $text, index $ind"
+ error "got bbox \{$bbox\} from $text, index $ind"
}
foreach {x1 y1 width height} $bbox break
set middle_y [expr {$y1 + ($height / 2)}]
@@ -128,10 +128,10 @@ proc _text_ind_to_x_y {text ind} {
proc _get_selection {widget} {
if {[string compare $widget [selection own]] != 0} {
- return ""
+ return ""
}
if {[catch {selection get} sel]} {
- return ""
+ return ""
}
return $sel
}
@@ -209,7 +209,7 @@ test event-2.2(keypress) {type into entry widget and then delete some text} -set
deleteWindows
} -result {MEL}
test event-2.3(keypress) {type into entry widget, triple click, hit Delete key,
- and then type some more} -setup {
+ and then type some more} -setup {
deleteWindows
} -body {
set t [toplevel .t]
@@ -222,10 +222,10 @@ test event-2.3(keypress) {type into entry widget, triple click, hit Delete key,
event generate $e <Enter>
for {set i 0} {$i < 3} {incr i} {
- _pause 100
- event generate $e <Button-1>
- _pause 100
- event generate $e <ButtonRelease-1>
+ _pause 100
+ event generate $e <Button-1>
+ _pause 100
+ event generate $e <ButtonRelease-1>
}
_keypress $e Delete
@@ -265,6 +265,7 @@ test event-2.5(keypress) {type into text widget and then delete some text} -setu
test event-2.6(keypress) {type into text widget, triple click,
hit Delete key, and then type some more} -setup {
deleteWindows
+ update idletasks
} -body {
set t [toplevel .t]
set e [text $t.e]
@@ -276,10 +277,10 @@ test event-2.6(keypress) {type into text widget, triple click,
event generate $e <Enter>
for {set i 0} {$i < 3} {incr i} {
- _pause 100
- event generate $e <Button-1>
- _pause 100
- event generate $e <ButtonRelease-1>
+ _pause 100
+ event generate $e <Button-1>
+ _pause 100
+ event generate $e <ButtonRelease-1>
}
_keypress $e Delete
@@ -318,10 +319,10 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests
set current $anchor
while {[$e compare $current <= $selend]} {
- foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
- event generate $e <B1-Motion> -x $current_x -y $current_y
- set current [$e index [list $current + 1 char]]
- _pause 50
+ foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+ event generate $e <B1-Motion> -x $current_x -y $current_y
+ set current [$e index [list $current + 1 char]]
+ _pause 50
}
event generate $e <ButtonRelease-1> -x $current_x -y $current_y
@@ -338,10 +339,10 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests
event generate $e <Button-1> -x $current_x -y $current_y
while {[$e compare $current >= [list $anchor - 4 char]]} {
- foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
- event generate $e <B1-Motion> -x $current_x -y $current_y
- set current [$e index [list $current - 1 char]]
- _pause 50
+ foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+ event generate $e <B1-Motion> -x $current_x -y $current_y
+ set current [$e index [list $current - 1 char]]
+ _pause 50
}
event generate $e <ButtonRelease-1> -x $current_x -y $current_y
@@ -385,10 +386,10 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests
set current $anchor
while {$current <= $selend} {
- foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
- event generate $e <B1-Motion> -x $current_x -y $current_y
- incr current
- _pause 50
+ foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+ event generate $e <B1-Motion> -x $current_x -y $current_y
+ incr current
+ _pause 50
}
event generate $e <ButtonRelease-1> -x $current_x -y $current_y
@@ -405,10 +406,10 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests
event generate $e <Button-1> -x $current_x -y $current_y
while {$current >= ($anchor - 4)} {
- foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
- event generate $e <B1-Motion> -x $current_x -y $current_y
- incr current -1
- _pause 50
+ foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
+ event generate $e <B1-Motion> -x $current_x -y $current_y
+ incr current -1
+ _pause 50
}
event generate $e <ButtonRelease-1> -x $current_x -y $current_y
@@ -567,7 +568,7 @@ test event-4.2(double-click-drag) {click down, click up, click down again,
} -result {select 11 7 select 4 { select} {Word select} 2}
test event-5.1(triple-click-drag) {Triple click and drag across lines in a
- text widget, this should extend the selection to the new line} -setup {
+ text widget, this should extend the selection to the new line} -setup {
deleteWindows
} -body {
set t [toplevel .t]
@@ -624,12 +625,12 @@ test event-5.1(triple-click-drag) {Triple click and drag across lines in a
} -cleanup {
deleteWindows
} -result [list "LINE THREE\n" "LINE TWO\nLINE THREE\n" \
- "LINE ONE\nLINE TWO\nLINE THREE\n"]
+ "LINE ONE\nLINE TWO\nLINE THREE\n"]
test event-6.1(button-state) {button press in a window that is then
- destroyed, when the mouse is moved into another window it
- should not generate a <B1-motion> event since the mouse
- was not pressed down in that window} -setup {
+ destroyed, when the mouse is moved into another window it
+ should not generate a <B1-motion> event since the mouse
+ was not pressed down in that window} -setup {
deleteWindows
} -body {
set t [toplevel .t]
@@ -781,8 +782,8 @@ test event-7.2(double-click) {A double click on a lone character
} -result {4 A 4 A}
test event-8 {event generate with keysyms corresponding to
- multi-byte virtual keycodes - bug
- e36963bfe8df9f5e528134707a91b9c0051de723} -constraints nonPortable -setup {
+ multi-byte virtual keycodes - bug
+ e36963bfe8df9f5e528134707a91b9c0051de723} -constraints nonPortable -setup {
deleteWindows
set res [list ]
} -body {
@@ -803,13 +804,13 @@ test event-8 {event generate with keysyms corresponding to
# (system-independent) known keysym, unless the system
# running the test does not have a keyboard with a
# diaeresis key.
- if {[expr {[lindex $res 3] ne "??"}]} {
- # keyboard has a physical diaeresis key and bug is fixed
- return "OK"
+ if {[lindex $res 3] ne "??"} {
+ # keyboard has a physical diaeresis key and bug is fixed
+ return "OK"
} else {
- return "Test failed, unless the keyboard tied to the system \
- on which this test is run does NOT have a diaeresis \
- physical key - in this case, test is actually void."
+ return "Test failed, unless the keyboard tied to the system \
+ on which this test is run does NOT have a diaeresis \
+ physical key - in this case, test is actually void."
}
} -cleanup {
deleteWindows
@@ -840,12 +841,18 @@ test event-9.1 {enter . window by destroying a toplevel - bug b1d115fa60} -setup
deleteWindows
bind . <Enter> $EnterBind
} -result {.}
-test event-9.2 {enter toplevel window by destroying a toplevel - bug b1d115fa60} -setup {
+
+# This test fails sporadically when run on the macOS CI runner. It does
+# not seem to fail on real computers. It is not needed since the same
+# thing is tested by 9.13. So it is simpler to constrain it as notAqua.
+test event-9.2 {enter toplevel window by destroying a toplevel - bug b1d115fa60} \
+-constraints { notAqua} \
+-setup {
set iconified false
if {[winfo ismapped .]} {
- wm iconify .
- update
- set iconified true
+ wm iconify .
+ update
+ set iconified true
}
} -body {
toplevel .top1
@@ -869,12 +876,318 @@ test event-9.2 {enter toplevel window by destroying a toplevel - bug b1d115fa60}
} -cleanup {
deleteWindows ; # destroy all children of ".", this already includes .top1
if {$iconified} {
- wm deiconify .
- update
+ wm deiconify .
+ update
}
} -result {.top1}
+proc waitForWindowEvent {w event {timeout 1000}} {
+# This proc is intended to overcome latency of windowing system
+# notifications when toplevel windows are involved. These latencies vary
+# considerably with the window manager in use, with the system load,
+# with configured scheduling priorities for processes, etc ...
+# Waiting for the corresponding window events evades the trouble that is
+# associated with the alternative: waiting or halting the Tk process for a
+# fixed amount of time (using "after ms"). With the latter strategy it's
+# always a gamble how much waiting time is enough on an end user's system.
+# It also leads to long fixed waiting times in order to be on the safe side.
+
+ variable _windowEvent
+
+ # Use counter as a unique ID to prevent subsequent waits
+ # from interfering with each other.
+ set counter [incr _windowEvent(counter)]
+ set _windowEvent($counter) 1
+ set savedBinding [bind $w $event]
+ bind $w $event [list +waitForWindowEvent.signal $counter]
+ set afterID [after $timeout [list set _windowEvent($counter) -1]]
+ vwait _windowEvent($counter)
+ set late [expr {$_windowEvent($counter) == -1}]
+ bind $w $event $savedBinding
+ unset _windowEvent($counter)
+ if {$late} {
+ puts stderr "wait for $event event on $w timed out (> $timeout ms)"
+ } else {
+ after cancel $afterID
+ }
+}
+proc waitForWindowEvent.signal {counter} {
+# Helper proc that records the triggering of a window event.
+ incr ::_windowEvent($counter)
+}
+
+proc create_and_pack_frames {{w {}}} {
+ frame $w.f1 -bg blue -width 200 -height 200
+ pack propagate $w.f1 0
+ frame $w.f1.f2 -bg yellow -width 100 -height 100
+ pack $w.f1.f2 $w.f1 -side bottom -anchor se
+ update idletasks
+}
+
+proc setup_win_mousepointer {w} {
+# Position the window and the mouse pointer as an initial state for some tests.
+# The so-called "pointer window" is the $w window that will now contain the mouse pointer.
+ wm geometry . +700+400; # root window out of our way - must not cover windows from event-9.1*
+ toplevel $w
+ pack propagate $w 0
+ wm geometry $w 300x300+100+100
+ tkwait visibility $w
+ update; # service remaining screen drawing events (e.g. <Expose>)
+ set pointerWin [winfo containing [winfo pointerx $w] [winfo pointery $w]]
+ event generate $w <Motion> -warp 1 -x 250 -y 250
+ if {($pointerWin ne $w) && ([tk windowingsystem] ne "aqua")} {
+ waitForWindowEvent $w <Enter>
+ } else {
+ controlPointerWarpTiming
+ }
+}
+
+test event-9.11 {pointer window container = parent} -setup {
+ setup_win_mousepointer .one
+ wm withdraw .one
+ create_and_pack_frames .one
+ wm deiconify .one
+ tkwait visibility .one.f1.f2
+ _pause 200; # needed for Windows
+ update idletasks; # finish display of window
+ set result "|"
+} -body {
+ bind all <Leave> {append result "<Leave> %d %W|"}
+ bind all <Enter> {append result "<Enter> %d %W|"}
+ destroy .one.f1.f2
+ update
+ set result
+} -cleanup {
+ bind all <Leave> {}
+ bind all <Enter> {}
+ destroy .one
+ unset result
+} -result {|<Enter> NotifyInferior .one.f1|}
+
+test event-9.12 {pointer window container != parent} -setup {
+ setup_win_mousepointer .one
+ wm withdraw .one
+ create_and_pack_frames .one
+ pack propagate .one.f1.f2 0
+ pack [frame .one.g -bg orange -width 80 -height 80] -anchor se -side bottom -in .one.f1.f2
+ wm deiconify .one
+ tkwait visibility .one.g
+ event generate .one <Motion> -warp 1 -x 250 -y 250
+ _pause 200; # needed for Windows
+ set result "|"
+} -body {
+ bind all <Leave> {append result "<Leave> %d %W|"}
+ bind all <Enter> {append result "<Enter> %d %W|"}
+ destroy .one.g
+ update
+ set result
+} -cleanup {
+ bind all <Leave> {}
+ bind all <Enter> {}
+ destroy .one
+ unset result
+} -result {|<Enter> NotifyNonlinearVirtual .one.f1|<Enter> NotifyNonlinear .one.f1.f2|}
+
+test event-9.13 {pointer window is a toplevel, toplevel destination} -setup {
+ setup_win_mousepointer .one
+ toplevel .two
+ wm geometry .two 300x300+150+150
+ wm withdraw .two
+ wm deiconify .two
+ waitForWindowEvent .two <Enter>
+ update idletasks; # finish displaying windows
+ set result |
+} -body {
+ bind all <Leave> {append result "<Leave> %d %W|"}
+ bind all <Enter> {append result "<Enter> %d %W|"}
+ destroy .two
+ waitForWindowEvent .one <Enter>
+ update
+ set result
+} -cleanup {
+ bind all <Leave> {}
+ bind all <Enter> {}
+ destroy .one
+ unset result
+} -result {|<Enter> NotifyNonlinear .one|}
+
+test event-9.14 {pointer window is a toplevel, tk internal destination} -setup {
+ setup_win_mousepointer .one
+ wm withdraw .one
+ create_and_pack_frames .one
+ toplevel .two
+ wm geometry .two 300x300+150+150
+ wm withdraw .two
+ wm deiconify .one
+ wm deiconify .two
+ waitForWindowEvent .two <Enter>
+ set result "|"
+} -body {
+ bind all <Leave> {append result "<Leave> %d %W|"}
+ bind all <Enter> {append result "<Enter> %d %W|"}
+ destroy .two
+ waitForWindowEvent .one.f1.f2 <Enter>
+ set result
+} -cleanup {
+ bind all <Leave> {}
+ bind all <Enter> {}
+ destroy .one
+ unset result
+} -result {|<Enter> NotifyNonlinearVirtual .one|<Enter> NotifyNonlinearVirtual .one.f1|<Enter> NotifyNonlinear .one.f1.f2|}
+
+test event-9.15 {pointer window is a toplevel, destination is screen root} -setup {
+ setup_win_mousepointer .one; # ensure the mouse pointer is where we want it to be (the .one toplevel is not itself used in this test)
+# destroy .one
+ toplevel .two
+ wm geometry .two 300x300+150+150
+ wm deiconify .two
+ waitForWindowEvent .two <Enter>
+ update idletasks; # finish displaying .two
+ event generate .two <Motion> -warp 1 -x 275 -y 275
+ controlPointerWarpTiming
+ set result "|"
+} -body {
+ bind all <Leave> {append result "<Leave> %d %W|"}
+ bind all <Enter> {append result "<Enter> %d %W|"}
+ destroy .two
+ set result
+} -cleanup {
+ bind all <Leave> {}
+ bind all <Enter> {}
+ destroy .one
+ unset result
+} -result {|}
+
+test event-9.16 {Successive destructions (pointer window + parent), single generation of crossing events} -setup {
+ # Tests correctness of overwriting the dead window struct in
+ # TkPointerDeadWindow() and subsequent reading in GenerateEnterLeave().
+ setup_win_mousepointer .one
+ wm withdraw .one
+ create_and_pack_frames .one
+ wm deiconify .one
+ tkwait visibility .one.f1.f2
+ update idletasks; # finish displaying window
+ _pause 200; # needed for Windows
+ set result "|"
+} -body {
+ bind all <Leave> {append result "<Leave> %d %W|"}
+ bind all <Enter> {append result "<Enter> %d %W|"}
+ destroy .one.f1
+ update
+ set result
+} -cleanup {
+ bind all <Leave> {}
+ bind all <Enter> {}
+ destroy .one
+ unset result
+} -result {|<Enter> NotifyInferior .one|}
+
+test event-9.17 {Successive destructions (pointer window + parent), separate crossing events} -setup {
+ # Tests correctness of overwriting the dead window struct in
+ # TkPointerDeadWindow() and subsequent reading in GenerateEnterLeave().
+ setup_win_mousepointer .one
+ wm withdraw .one
+ create_and_pack_frames .one
+ wm deiconify .one
+ tkwait visibility .one.f1.f2
+ update idletasks; # finish displaying window
+ _pause 200; # needed for Windows
+ set result "|"
+} -body {
+ bind all <Leave> {append result "<Leave> %d %W|"}
+ bind all <Enter> {append result "<Enter> %d %W|"}
+ destroy .one.f1.f2
+ update; # make sure window is gone
+ destroy .one.f1
+ update; # make sure window is gone
+ set result
+} -cleanup {
+ bind all <Leave> {}
+ bind all <Enter> {}
+ destroy .one
+ unset result
+} -result {|<Enter> NotifyInferior .one.f1|<Enter> NotifyInferior .one|}
+
+test event-9.18 {Successive destructions (pointer window + ancestors including its toplevel), destination is non-root toplevel} -setup {
+ setup_win_mousepointer .one
+ toplevel .two
+ pack propagate .two 0
+ wm geometry .two 300x300+100+100
+ create_and_pack_frames .two
+ wm deiconify .two
+ waitForWindowEvent .two.f1.f2 <Enter>
+ set result "|"
+} -body {
+ bind all <Leave> {append result "<Leave> %d %W|"}
+ bind all <Enter> {append result "<Enter> %d %W|"}
+ destroy .two
+ waitForWindowEvent .one <Enter>
+ set result
+} -cleanup {
+ bind all <Leave> {}
+ bind all <Enter> {}
+ destroy .one
+ unset result
+} -result {|<Enter> NotifyNonlinear .one|}
+
+test event-9.19 {Successive destructions (pointer window + ancestors including its toplevel), destination is internal window, bypass root win} -setup {
+ setup_win_mousepointer .one; # ensure the mouse pointer is where we want it to be (the .one toplevel is not itself used in this test)
+# destroy .one
+ toplevel .two
+ pack propagate .two 0
+ wm geometry .two 300x300+100+100
+ create_and_pack_frames .two
+ wm deiconify .two
+ toplevel .three
+ pack propagate .three 0
+ wm geometry .three 300x300+110+110
+ create_and_pack_frames .three
+ wm deiconify .three
+ waitForWindowEvent .three.f1.f2 <Enter>
+ update idletasks; # finish displaying windows
+ set result "|"
+} -body {
+ bind all <Leave> {append result "<Leave> %d %W|"}
+ bind all <Enter> {append result "<Enter> %d %W|"}
+ destroy .three
+ waitForWindowEvent .two.f1.f2 <Enter>
+ update idletasks; #finish destroying .two
+ set result
+} -cleanup {
+ bind all <Leave> {}
+ bind all <Enter> {}
+ destroy .one
+ destroy .two
+ unset result
+} -result {|<Enter> NotifyNonlinearVirtual .two|<Enter> NotifyNonlinearVirtual .two.f1|<Enter> NotifyNonlinear .two.f1.f2|}
+
+test event-9.20 {Successive destructions (pointer window + ancestors including its toplevel), destination is screen root} -setup {
+ setup_win_mousepointer .one; # ensure the mouse pointer is where we want it to be (the .one toplevel is not itself used in this test)
+ destroy .one
+ toplevel .two
+ pack propagate .two 0
+ wm geometry .two 300x300+100+100
+ create_and_pack_frames .two
+ wm deiconify .two
+ waitForWindowEvent .two.f1.f2 <Enter>
+ set result "|"
+} -body {
+ bind all <Leave> {append result "<Leave> %d %W|"}
+ bind all <Enter> {append result "<Enter> %d %W|"}
+ destroy .two
+ update idletasks; #finish destroying .two
+ set result
+} -cleanup {
+ bind all <Leave> {}
+ bind all <Enter> {}
+ unset result
+} -result {|}
+
# cleanup
+# macOS sometimes has trouble deleting the test window,
+# causing a failure in focus.test.
+_pause 200;
+deleteWindows
update
unset -nocomplain keypress_lookup
rename _init_keypress_lookup {}
@@ -883,6 +1196,8 @@ rename _keypress {}
rename _pause {}
rename _text_ind_to_x_y {}
rename _get_selection {}
+rename create_and_pack_frames {}
+rename setup_win_mousepointer {}
cleanupTests
return
generated by cgit v0.12 at 2025-12-07 11:03:09 (GMT)