summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/event.test478
-rw-r--r--tests/font.test13
-rw-r--r--tests/pack.test14
-rw-r--r--tests/ttk/ttk.test5
-rw-r--r--tests/unixWm.test11
-rw-r--r--tests/winfo.test2
-rw-r--r--tests/wm.test2
-rw-r--r--tests/xmfbox.test7
8 files changed, 430 insertions, 102 deletions
diff --git a/tests/event.test b/tests/event.test
index c56d4d8..8058069 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test the code in tkEvent.c. It is
# organized in the standard fashion for Tcl tests.
#
-# Copyright © 1994 The Regents of the University of California.
-# Copyright © 1994-1995 Sun Microsystems, Inc.
-# Copyright © 1998-1999 Scriptics Corporation.
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
@@ -20,10 +20,57 @@ namespace import -force tcltest::test
proc _init_keypress_lookup {} {
global keypress_lookup
+ scan A %c start
+ scan Z %c finish
+
+ for {set i $start} {$i <= $finish} {incr i} {
+ set l [format %c $i]
+ set keypress_lookup($l) $l
+ }
+
+ scan a %c start
+ scan z %c finish
+
+ for {set i $start} {$i <= $finish} {incr i} {
+ set l [format %c $i]
+ set keypress_lookup($l) $l
+ }
+
+ scan 0 %c start
+ scan 9 %c finish
+
+ for {set i $start} {$i <= $finish} {incr i} {
+ set l [format %c $i]
+ set keypress_lookup($l) $l
+ }
+
+ # Most punctuation
+ array set keypress_lookup {
+ ! exclam
+ % percent
+ & ampersand
+ ( parenleft
+ ) parenright
+ * asterisk
+ + plus
+ , comma
+ - minus
+ . period
+ / slash
+ : colon
+ < less
+ = equal
+ > greater
+ ? question
+ @ at
+ ^ asciicircum
+ _ underscore
+ | bar
+ ~ asciitilde
+ ' apostrophe
+ }
# Characters with meaning to Tcl...
array set keypress_lookup [list \
- - minus \
- > greater \
\" quotedbl \
\# numbersign \
\$ dollar \
@@ -34,7 +81,6 @@ proc _init_keypress_lookup {} {
\{ braceleft \
\} braceright \
" " space \
- \xA0 nobreakspace \
"\n" Return \
"\t" Tab]
}
@@ -42,8 +88,8 @@ proc _init_keypress_lookup {} {
# Lookup an event in the keypress table.
# For example:
# Q -> Q
-# ; -> semicolon
-# > -> greater
+# . -> period
+# / -> slash
# Delete -> Delete
# Escape -> Escape
@@ -65,7 +111,7 @@ proc _keypress_lookup {char} {
}
}
-# Lookup and generate a pair of Key and KeyRelease events
+# Lookup and generate a pair of KeyPress and KeyRelease events
proc _keypress {win key} {
set keysym [_keypress_lookup $key]
@@ -78,7 +124,7 @@ proc _keypress {win key} {
if {[focus] != $win} {
focus -force $win
}
- event generate $win <Key-$keysym>
+ event generate $win <KeyPress-$keysym>
_pause 50
if {[focus] != $win} {
focus -force $win
@@ -148,10 +194,10 @@ test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} -setup
update
bind .b <Destroy> {
lappend x destroy
- event generate .b <Button-1>
+ event generate .b <1>
event generate .b <ButtonRelease-1>
}
- bind .b <Button-1> {
+ bind .b <1> {
lappend x button
}
@@ -223,7 +269,7 @@ 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>
+ event generate $e <ButtonPress-1>
_pause 100
event generate $e <ButtonRelease-1>
}
@@ -265,6 +311,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]
@@ -277,7 +324,7 @@ 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>
+ event generate $e <ButtonPress-1>
_pause 100
event generate $e <ButtonRelease-1>
}
@@ -309,7 +356,7 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests
# Click down to set the insert cursor position
event generate $e <Enter>
- event generate $e <Button-1> -x $anchor_x -y $anchor_y
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
# Save the position of the insert cursor
lappend result [$e index insert]
@@ -335,7 +382,7 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests
# Now click and click and drag to the left, over "Tcl/Tk selection"
- event generate $e <Button-1> -x $current_x -y $current_y
+ event generate $e <ButtonPress-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
@@ -376,7 +423,7 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests
# Click down to set the insert cursor position
event generate $e <Enter>
- event generate $e <Button-1> -x $anchor_x -y $anchor_y
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
# Save the position of the insert cursor
lappend result [$e index insert]
@@ -402,7 +449,7 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests
# Now click and click and drag to the left, over "Tcl/Tk selection"
- event generate $e <Button-1> -x $current_x -y $current_y
+ event generate $e <ButtonPress-1> -x $current_x -y $current_y
while {$current >= ($anchor - 4)} {
foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
@@ -441,11 +488,11 @@ test event-4.1(double-click-drag) {click down, click up, click down again,
# Click down, release, then click down again
event generate $e <Enter>
- event generate $e <Button-1> -x $anchor_x -y $anchor_y
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
_pause 50
event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
_pause 50
- event generate $e <Button-1> -x $anchor_x -y $anchor_y
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
_pause 50
# Save the highlighted text
@@ -512,11 +559,11 @@ test event-4.2(double-click-drag) {click down, click up, click down again,
# Click down, release, then click down again
event generate $e <Enter>
- event generate $e <Button-1> -x $anchor_x -y $anchor_y
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
_pause 50
event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
_pause 50
- event generate $e <Button-1> -x $anchor_x -y $anchor_y
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
_pause 50
set result [list]
@@ -584,17 +631,17 @@ test event-5.1(triple-click-drag) {Triple click and drag across lines in a
event generate $e <Enter>
- event generate $e <Button-1> -x $anchor_x -y $anchor_y
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
_pause 50
event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
_pause 50
- event generate $e <Button-1> -x $anchor_x -y $anchor_y
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
_pause 50
event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
_pause 50
- event generate $e <Button-1> -x $anchor_x -y $anchor_y
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
_pause 50
set result [list]
@@ -634,7 +681,7 @@ test event-6.1(button-state) {button press in a window that is then
} -body {
set t [toplevel .t]
- event generate $t <Button-1>
+ event generate $t <ButtonPress-1>
destroy $t
set t [toplevel .t]
set motion nomotion
@@ -673,11 +720,11 @@ test event-7.1(double-click) {A double click on a lone character
# Double click near left hand egde of the letter A
event generate $e <Enter>
- event generate $e <Button-1> -x $left_x -y $left_y
+ event generate $e <ButtonPress-1> -x $left_x -y $left_y
_pause 50
event generate $e <ButtonRelease-1> -x $left_x -y $left_y
_pause 50
- event generate $e <Button-1> -x $left_x -y $left_y
+ event generate $e <ButtonPress-1> -x $left_x -y $left_y
_pause 50
event generate $e <ButtonRelease-1> -x $left_x -y $left_y
_pause 50
@@ -688,18 +735,18 @@ test event-7.1(double-click) {A double click on a lone character
# Clear selection by clicking at 0,0
- event generate $e <Button-1> -x 0 -y 0
+ event generate $e <ButtonPress-1> -x 0 -y 0
_pause 50
event generate $e <ButtonRelease-1> -x 0 -y 0
_pause 50
# Double click near right hand edge of the letter A
- event generate $e <Button-1> -x $right_x -y $right_y
+ event generate $e <ButtonPress-1> -x $right_x -y $right_y
_pause 50
event generate $e <ButtonRelease-1> -x $right_x -y $right_y
_pause 50
- event generate $e <Button-1> -x $right_x -y $right_y
+ event generate $e <ButtonPress-1> -x $right_x -y $right_y
_pause 50
event generate $e <ButtonRelease-1> -x $right_x -y $right_y
_pause 50
@@ -740,11 +787,11 @@ test event-7.2(double-click) {A double click on a lone character
# Double click near left hand egde of the letter A
event generate $e <Enter>
- event generate $e <Button-1> -x $left_x -y $left_y
+ event generate $e <ButtonPress-1> -x $left_x -y $left_y
_pause 50
event generate $e <ButtonRelease-1> -x $left_x -y $left_y
_pause 50
- event generate $e <Button-1> -x $left_x -y $left_y
+ event generate $e <ButtonPress-1> -x $left_x -y $left_y
_pause 50
event generate $e <ButtonRelease-1> -x $left_x -y $left_y
_pause 50
@@ -755,18 +802,18 @@ test event-7.2(double-click) {A double click on a lone character
# Clear selection by clicking at 0,0
- event generate $e <Button-1> -x 0 -y 0
+ event generate $e <ButtonPress-1> -x 0 -y 0
_pause 50
event generate $e <ButtonRelease-1> -x 0 -y 0
_pause 50
# Double click near right hand edge of the letter A
- event generate $e <Button-1> -x $right_x -y $right_y
+ event generate $e <ButtonPress-1> -x $right_x -y $right_y
_pause 50
event generate $e <ButtonRelease-1> -x $right_x -y $right_y
_pause 50
- event generate $e <Button-1> -x $right_x -y $right_y
+ event generate $e <ButtonPress-1> -x $right_x -y $right_y
_pause 50
event generate $e <ButtonRelease-1> -x $right_x -y $right_y
_pause 50
@@ -790,7 +837,7 @@ test event-8 {event generate with keysyms corresponding to
set e [entry $t.e]
pack $e
tkwait visibility $e
- bind $e <Key> {lappend res keycode: %k keysym: %K}
+ bind $e <KeyPress> {lappend res keycode: %k keysym: %K}
focus -force $e
update
event generate $e <diaeresis>
@@ -815,66 +862,313 @@ test event-8 {event generate with keysyms corresponding to
deleteWindows
} -result {OK}
-test event-9.1 {enter . window by destroying a toplevel - bug b1d115fa60} -setup {
- set EnterBind [bind . <Enter>]
-} -body {
- wm geometry . 200x200+300+300
- wm deiconify .
- _pause 200
- toplevel .top2 -width 200 -height 200
- wm geometry .top2 +[expr {[winfo rootx .]+50}]+[expr {[winfo rooty .]+50}]
- update idletasks
- wm deiconify .top2
- update idletasks
- raise .top2
- _pause 400
- event generate .top2 <Motion> -warp 1 -x 50 -y 50
- _pause 100
- bind . <Enter> {lappend res %W}
- set res [list ]
- destroy .top2
+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
- _pause 200
- set res
-} -cleanup {
- deleteWindows
- bind . <Enter> $EnterBind
-} -result {.}
-test event-9.2 {enter toplevel window by destroying a toplevel - bug b1d115fa60} -setup {
- set iconified false
- if {[winfo ismapped .]} {
- wm iconify .
- update
- set iconified true
+}
+
+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 {
- toplevel .top1
- wm geometry .top1 200x200+300+300
- wm deiconify .top1
- _pause 200
- toplevel .top2 -width 200 -height 200
- wm geometry .top2 +[expr {[winfo rootx .top1]+50}]+[expr {[winfo rooty .top1]+50}]
- _pause 200
- wm deiconify .top2
- update idletasks
- raise .top2
- _pause 400
- event generate .top2 <Motion> -warp 1 -x 50 -y 50
- _pause 100
- bind .top1 <Enter> {lappend res %W}
- set res [list ]
- destroy .top2
- _pause 200
- set res
+ bind all <Leave> {append result "<Leave> %d %W|"}
+ bind all <Enter> {append result "<Enter> %d %W|"}
+ destroy .one.f1.f2
+ update
+ set result
} -cleanup {
- deleteWindows ; # destroy all children of ".", this already includes .top1
- if {$iconified} {
- wm deiconify .
- update
- }
-} -result {.top1}
+ 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 +1177,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
diff --git a/tests/font.test b/tests/font.test
index ca38269..4c1f0de 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -2434,15 +2434,15 @@ test font-47.2 {Bug 3049518 - Canvas} -body {
set twidth [font measure MyFont $text]
set theight [font metrics MyFont -linespace]
set circid [$c create polygon \
- 15 15 \
- [expr {15 + $twidth}] 15 \
- [expr {15 + $twidth}] [expr {15 + $theight}] \
- 15 [expr {15 + $theight}] \
- -width 1 -joinstyle round -smooth true -fill {} -outline blue]
+ 15 15 \
+ [expr {15 + $twidth}] 15 \
+ [expr {15 + $twidth}] [expr {15 + $theight}] \
+ 15 [expr {15 + $theight}] \
+ -width 1 -joinstyle round -smooth true -fill {} -outline blue]
pack $c -fill both -expand 1 -side top
update
- # Lamda test functions
+ # Lambda test functions
set circle_text {{w user_data text circ} {
if {[winfo class $w] ne "Canvas"} {
puts "Wrong widget type: $w"
@@ -2468,6 +2468,7 @@ test font-47.2 {Bug 3049518 - Canvas} -body {
apply $circle_text $c FontChanged $textid $circid
update
bind $c <<TkWorldChanged>> [list apply $circle_text %W %d $textid $circid]
+ update idletasks
# Begin test:
set results {}
diff --git a/tests/pack.test b/tests/pack.test
index 0731125..201bf9f 100644
--- a/tests/pack.test
+++ b/tests/pack.test
@@ -1553,6 +1553,11 @@ test pack-17.2 {PackLostContentProc procedure} -setup {
# into account while the window is unmapped.
# pack-18.1.2 checks that, on Windows, width/height changes are taken into
# account on window remapping.
+#
+# While these tests pass on macOS, one can see by watching the tests
+# that the window .pack is sometimes black, even though the frame is
+# colored. So, evidently, even though the size changes are honored,
+# the window is sometimes not completely configured.
test pack-18.1.1 {unmap content when container unmapped} -constraints {
macOrUnix failsOnUbuntu failsOnXQuarz
} -setup {
@@ -1562,7 +1567,8 @@ test pack-18.1.1 {unmap content when container unmapped} -constraints {
# as the screen (screen switch causes scale and other tests to fail).
wm geometry .pack +100+100
} -body {
- frame .pack.a -width 100 -height 50 -relief raised -bd 2
+ frame .pack.a -width 100 -height 50 -relief raised -bd 2 -bg green
+ after 100
pack .pack.a
update
set result [winfo ismapped .pack.a]
@@ -1585,7 +1591,7 @@ test pack-18.1.2 {unmap content when container unmapped} -constraints {
# as the screen (screen switch causes scale and other tests to fail).
wm geometry .pack +100+100
} -body {
- frame .pack.a -width 100 -height 50 -relief raised -bd 2
+ frame .pack.a -width 100 -height 50 -relief raised -bd 2 -bg green
pack .pack.a
update
set result [winfo ismapped .pack.a]
@@ -1606,8 +1612,8 @@ test pack-18.2 {unmap content when container unmapped} -constraints {failsOnUbun
# as the screen (screen switch causes scale and other tests to fail).
wm geometry .pack +100+100
} -body {
- frame .pack.a -relief raised -bd 2
- frame .pack.b -width 70 -height 30 -relief sunken -bd 2
+ frame .pack.a -relief raised -bd 2 -bg green
+ frame .pack.b -width 70 -height 30 -relief sunken -bd 2 -bg red
pack .pack.a
pack .pack.b -in .pack.a
update
diff --git a/tests/ttk/ttk.test b/tests/ttk/ttk.test
index 74cd80a..d099c40 100644
--- a/tests/ttk/ttk.test
+++ b/tests/ttk/ttk.test
@@ -136,6 +136,8 @@ test ttk-selfdestruct-ok-1 "Intentional self-destruction" -body {
# Basic tests.
#
test ttk-1.1 "Create multiline button showing justified text" -body {
+ wm geometry . +100+100
+ event generate . <Motion> -warp 1 -x 600 -y 600
pack [ttk::button .t -text "Hello\nWorld!!" -justify center] -expand true -fill both
update
}
@@ -152,6 +154,8 @@ test ttk-1.4 "Original style preserved" -body {
.t cget -style
} -result ""
+# Tests using this will fail if the top-level window contains the cursor
+
proc checkstate {w} {
foreach statespec {
{!active !disabled}
@@ -166,7 +170,6 @@ proc checkstate {w} {
set result
}
-# NB: this will fail if the top-level window pops up underneath the cursor
test ttk-2.0 "Check state" -body {
checkstate .t
} -result [list 1 0 0 0 0 0]
diff --git a/tests/unixWm.test b/tests/unixWm.test
index 2ad40e2..0a86082 100644
--- a/tests/unixWm.test
+++ b/tests/unixWm.test
@@ -105,6 +105,7 @@ foreach geom "+20+80 +80+$Y0 +0+$Y0 -0-0 +0-0 -0+$Y0 -10-5 -10+$Y5 +10-5" {
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-3.$i {moving window while iconified} unix {
+ update
wm iconify .t
update idletasks
wm geom .t $geom
@@ -641,6 +642,8 @@ test unixWm-16.1 {Tk_WmCmd procedure, "deiconify" option} unix {
test unixWm-16.2 {Tk_WmCmd procedure, "deiconify" option} unix {
destroy .icon
toplevel .icon -width 50 -height 50 -bg red
+ # calling update here prevents a crash in 16.3 on macOS
+ update
wm iconwindow .t .icon
set result [list [catch {wm deiconify .icon} msg] $msg]
destroy .icon
@@ -1352,8 +1355,12 @@ test unixWm-38.2 {Tk_WmCmd procedure, "withdraw" option} unix {
test unixWm-38.3 {Tk_WmCmd procedure, "withdraw" option} unix {
set result {}
wm withdraw .t
+ #added to avoid a crash on macOS
+ update
lappend result [wm state .t] [winfo ismapped .t]
wm deiconify .t
+ #added to avoid a crash on macOS
+ update
lappend result [wm state .t] [winfo ismapped .t]
} {withdrawn 0 normal 1}
@@ -1373,7 +1380,9 @@ test unixWm-40.1 {Tk_SetGrid procedure, set grid dimensions before turning on gr
wm geometry .t
} {30x10+0+0}
test unixWm-40.2 {Tk_SetGrid procedure, turning on grid when dimensions already set} unix {
+ update
destroy .t
+ update
toplevel .t
wm geometry .t 200x100+100+$Y0
listbox .t.l -height 20 -width 20
@@ -1798,6 +1807,8 @@ test unixWm-49.2 {Tk_GetRootCoords procedure, menubars} {unix testmenubar} {
} {52 7 12 62}
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.
diff --git a/tests/winfo.test b/tests/winfo.test
index d4cc1ff..908647b 100644
--- a/tests/winfo.test
+++ b/tests/winfo.test
@@ -441,8 +441,10 @@ test winfo-13.3 {destroying container window} -setup {
test winfo-13.4 {[winfo containing] with embedded windows} -setup {
deleteWindows
} -body {
+ wm geometry . +100+100
frame .con -container 1
pack .con -expand yes -fill both
+ update
toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0
button .emb.b
pack .emb.b -expand yes -fill both
diff --git a/tests/wm.test b/tests/wm.test
index d913006..650292d 100644
--- a/tests/wm.test
+++ b/tests/wm.test
@@ -1084,6 +1084,8 @@ test wm-iconwindow-1.5 {usage} -setup {
} -result {.icon is already an icon for .t2}
test wm-iconwindow-2.1 {setting and reading values} -setup {
+ # without this macOS crashes for unknown reasons
+ wm iconwindow .t {}
destroy .icon
set result {}
} -body {
diff --git a/tests/xmfbox.test b/tests/xmfbox.test
index 89eda3c..0d3b4d3 100644
--- a/tests/xmfbox.test
+++ b/tests/xmfbox.test
@@ -54,6 +54,7 @@ proc cleanup {} {
}
catch {unset foo}
destroy .foo
+ update
}
# ----------------------------------------------------------------------
@@ -76,6 +77,7 @@ test xmfbox-1.2 {tk::MotifFDialog_Create, -parent switch} -constraints {
} -body {
toplevel .bar
wm geometry .bar +0+0
+ update
set x [tk::MotifFDialog_Create foo open {-parent .bar}]
} -cleanup {
destroy $x
@@ -89,6 +91,7 @@ test xmfbox-2.1 {tk::MotifFDialog_InterpFilter, ~ in dir names} -constraints {
cleanup
file mkdir ./~nosuchuser1
set x [tk::MotifFDialog_Create foo open {}]
+ update
$::tk::dialog::file::foo(fEnt) delete 0 end
$::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1
file normalize [file join {*}[tk::MotifFDialog_InterpFilter $x]]
@@ -100,6 +103,7 @@ test xmfbox-2.2 {tk::MotifFDialog_InterpFilter, ~ in file names} -constraints {
cleanup
close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
set x [tk::MotifFDialog_Create foo open {}]
+ update
$::tk::dialog::file::foo(fEnt) delete 0 end
$::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1
file normalize [file join {*}[tk::MotifFDialog_InterpFilter $x]]
@@ -111,6 +115,7 @@ test xmfbox-2.3 {tk::MotifFDialog_Update, ~ in file names} -constraints {
cleanup
close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
set x [tk::MotifFDialog_Create foo open {}]
+ update
$::tk::dialog::file::foo(fEnt) delete 0 end
$::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1
tk::MotifFDialog_InterpFilter $x
@@ -124,6 +129,7 @@ test xmfbox-2.4 {tk::MotifFDialog_LoadFile, ~ in file names} -constraints {
cleanup
close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
set x [tk::MotifFDialog_Create foo open {}]
+ update
set i [lsearch [$::tk::dialog::file::foo(fList) get 0 end] ~nosuchuser1]
expr {$i >= 0}
} -result 1
@@ -134,6 +140,7 @@ test xmfbox-2.5 {tk::MotifFDialog_BrowseFList, ~ in file names} -constraints {
cleanup
close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
set x [tk::MotifFDialog_Create foo open {}]
+ update
set i [lsearch [$::tk::dialog::file::foo(fList) get 0 end] ~nosuchuser1]
$::tk::dialog::file::foo(fList) selection clear 0 end
$::tk::dialog::file::foo(fList) selection set $i
generated by cgit v0.12 at 2024-11-10 03:13:36 (GMT)