diff options
Diffstat (limited to 'tests/focus.test')
| -rw-r--r-- | tests/focus.test | 556 |
1 files changed, 328 insertions, 228 deletions
diff --git a/tests/focus.test b/tests/focus.test index 5cc3abe..45cf73b 100644 --- a/tests/focus.test +++ b/tests/focus.test @@ -6,26 +6,24 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands - -button .b -text .b -relief raised -bd 2 -pack .b +namespace import -force tcltest::test proc focusSetup {} { - catch {destroy .t} + destroy .t toplevel .t wm geom .t +0+0 foreach i {b1 b2 b3 b4} { - button .t.$i -text .t.$i -relief raised -bd 2 - pack .t.$i + button .t.$i -text .t.$i -relief raised -bd 2 + pack .t.$i } tkwait visibility .t.b4 } proc focusSetupAlt {} { global env - catch {destroy .alt} + destroy .alt toplevel .alt -screen $env(TK_ALT_DISPLAY) foreach i {a b c d} { button .alt.$i -text .alt.$i -relief raised -bd 2 @@ -34,8 +32,6 @@ proc focusSetupAlt {} { tkwait visibility .alt.d } -# Make sure the window manager knows who has focus -catch {fixfocus} # The following procedure ensures that there is no input focus # in this application. It does it by arranging for another @@ -43,7 +39,6 @@ catch {fixfocus} # is needed to wait long enough for pending actions to get through # the X server and possibly also the window manager. -setupbg proc focusClear {} { global x; after 200 {set x 1} @@ -52,12 +47,17 @@ proc focusClear {} { update } -focusSetup -if {[testConstraint altDisplay]} { - focusSetupAlt -} -update +# Button used in some tests in the whole test file +button .b -text .b -relief raised -bd 2 +pack .b + +# Make sure the window manager knows who has focus +catch {fixfocus} + +# cleanupbg will be after 4.3 test +setupbg +update bind all <FocusIn> { append focusInfo "in %W %d\n" } @@ -67,36 +67,48 @@ bind all <FocusOut> { bind all <KeyPress> { append focusInfo "press %W %K" } +focusSetup +if {[testConstraint altDisplay]} { + focusSetupAlt +} -test focus-1.1 {Tk_FocusCmd procedure} unix { + +test focus-1.1 {Tk_FocusCmd procedure} -constraints unix -body { focusClear focus -} {} -test focus-1.2 {Tk_FocusCmd procedure} {unix altDisplay} { +} -result {} +test focus-1.2 {Tk_FocusCmd procedure} -constraints { + unix altDisplay +} -body { focus .alt.b focus -} {} -test focus-1.3 {Tk_FocusCmd procedure} unix { +} -result {} +test focus-1.3 {Tk_FocusCmd procedure} -constraints unix -body { focusClear focus .t.b3 focus -} {} -test focus-1.4 {Tk_FocusCmd procedure} unix { - list [catch {focus ""} msg] $msg -} {0 {}} -test focus-1.5 {Tk_FocusCmd procedure} unix { +} -result {} +test focus-1.4 {Tk_FocusCmd procedure} -constraints unix -body { + focus "" +} -returnCodes ok -result {} +test focus-1.5 {Tk_FocusCmd procedure} -constraints unix -body { focusClear focus -force .t focus .t.b3 focus -} {.t.b3} -test focus-1.6 {Tk_FocusCmd procedure} unix { - list [catch {focus .gorp} msg] $msg -} {1 {bad window path name ".gorp"}} -test focus-1.7 {Tk_FocusCmd procedure} unix { - list [catch {focus .gorp a} msg] $msg -} {1 {bad option ".gorp": must be -displayof, -force, or -lastfor}} -test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} unix { +} -result {.t.b3} +test focus-1.6 {Tk_FocusCmd procedure} -constraints unix -body { + focus .gorp +} -returnCodes error -result {bad window path name ".gorp"} +test focus-1.7 {Tk_FocusCmd procedure} -constraints unix -body { + focus .gorp a +} -returnCodes error -result {bad option ".gorp": must be -displayof, -force, or -lastfor} +test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} -constraints { + unix +} -setup { + destroy .t2 +} -body { + focusClear toplevel .t2 wm geom .t2 +10+10 frame .t2.f -width 200 -height 100 -bd 2 -relief raised @@ -113,109 +125,146 @@ test focus-1.8 {Tk_FocusCmd procedure, focussing on dead window} unix { destroy .t2.f lappend x [focus] destroy .t2 - set x -} {.t2.f2 .t2 .t2} -test focus-1.9 {Tk_FocusCmd procedure, -displayof option} unix { - list [catch {focus -displayof} msg] $msg -} {1 {wrong # args: should be "focus -displayof window"}} -test focus-1.10 {Tk_FocusCmd procedure, -displayof option} unix { - list [catch {focus -displayof a b} msg] $msg -} {1 {wrong # args: should be "focus -displayof window"}} -test focus-1.11 {Tk_FocusCmd procedure, -displayof option} unix { - list [catch {focus -displayof .lousy} msg] $msg -} {1 {bad window path name ".lousy"}} -test focus-1.12 {Tk_FocusCmd procedure, -displayof option} unix { + return $x +} -cleanup { + destroy .t2 +} -result {.t2.f2 .t2 .t2} +test focus-1.9 {Tk_FocusCmd procedure, -displayof option} -constraints { + unix +} -body { + focus -displayof +} -returnCodes error -result {wrong # args: should be "focus -displayof window"} +test focus-1.10 {Tk_FocusCmd procedure, -displayof option} -constraints { + unix +} -body { + focus -displayof a b +} -returnCodes error -result {wrong # args: should be "focus -displayof window"} +test focus-1.11 {Tk_FocusCmd procedure, -displayof option} -constraints { + unix +} -body { + focus -displayof .lousy +} -returnCodes error -result {bad window path name ".lousy"} +test focus-1.12 {Tk_FocusCmd procedure, -displayof option} -constraints { + unix +} -body { focusClear focus .t focus -displayof .t.b3 -} {} -test focus-1.13 {Tk_FocusCmd procedure, -displayof option} unix { +} -result {} +test focus-1.13 {Tk_FocusCmd procedure, -displayof option} -constraints { + unix +} -body { focusClear focus -force .t focus -displayof .t.b3 -} {.t} -test focus-1.14 {Tk_FocusCmd procedure, -displayof option} {unix altDisplay} { +} -result {.t} +test focus-1.14 {Tk_FocusCmd procedure, -displayof option} -constraints { + unix altDisplay +} -body { + focusClear focus -force .alt.c focus -displayof .alt -} {.alt.c} -test focus-1.15 {Tk_FocusCmd procedure, -force option} unix { - list [catch {focus -force} msg] $msg -} {1 {wrong # args: should be "focus -force window"}} -test focus-1.16 {Tk_FocusCmd procedure, -force option} unix { - list [catch {focus -force a b} msg] $msg -} {1 {wrong # args: should be "focus -force window"}} -test focus-1.17 {Tk_FocusCmd procedure, -force option} unix { - list [catch {focus -force foo} msg] $msg -} {1 {bad window path name "foo"}} -test focus-1.18 {Tk_FocusCmd procedure, -force option} unix { - list [catch {focus -force ""} msg] $msg -} {0 {}} -test focus-1.19 {Tk_FocusCmd procedure, -force option} unix { +} -result {.alt.c} +test focus-1.15 {Tk_FocusCmd procedure, -force option} -constraints unix -body { + focus -force +} -returnCodes error -result {wrong # args: should be "focus -force window"} +test focus-1.16 {Tk_FocusCmd procedure, -force option} -constraints unix -body { + focus -force a b +} -returnCodes error -result {wrong # args: should be "focus -force window"} +test focus-1.17 {Tk_FocusCmd procedure, -force option} -constraints unix -body { + focus -force foo +} -returnCodes error -result {bad window path name "foo"} +test focus-1.18 {Tk_FocusCmd procedure, -force option} -constraints unix -body { + focus -force "" +} -returnCodes ok -result {} +test focus-1.19 {Tk_FocusCmd procedure, -force option} -constraints unix -body { focusClear focus .t.b1 set x [list [focus]] focus -force .t.b1 lappend x [focus] -} {{} .t.b1} -test focus-1.20 {Tk_FocusCmd procedure, -lastfor option} unix { - list [catch {focus -lastfor} msg] $msg -} {1 {wrong # args: should be "focus -lastfor window"}} -test focus-1.21 {Tk_FocusCmd procedure, -lastfor option} unix { - list [catch {focus -lastfor 1 2} msg] $msg -} {1 {wrong # args: should be "focus -lastfor window"}} -test focus-1.22 {Tk_FocusCmd procedure, -lastfor option} unix { - list [catch {focus -lastfor who_knows?} msg] $msg -} {1 {bad window path name "who_knows?"}} -test focus-1.23 {Tk_FocusCmd procedure, -lastfor option} unix { +} -result {{} .t.b1} +test focus-1.20 {Tk_FocusCmd procedure, -lastfor option} -constraints { + unix +} -body { + focus -lastfor +} -returnCodes error -result {wrong # args: should be "focus -lastfor window"} +test focus-1.21 {Tk_FocusCmd procedure, -lastfor option} -constraints { + unix +} -body { + focus -lastfor 1 2 +} -returnCodes error -result {wrong # args: should be "focus -lastfor window"} +test focus-1.22 {Tk_FocusCmd procedure, -lastfor option} -constraints { + unix +} -body { + focus -lastfor who_knows? +} -returnCodes error -result {bad window path name "who_knows?"} +test focus-1.23 {Tk_FocusCmd procedure, -lastfor option} -constraints { + unix +} -body { + focusClear + focusSetup focus .b focus .t.b1 list [focus -lastfor .] [focus -lastfor .t.b3] -} {.b .t.b1} -test focus-1.24 {Tk_FocusCmd procedure, -lastfor option} unix { - destroy .t +} -result {.b .t.b1} +test focus-1.24 {Tk_FocusCmd procedure, -lastfor option} -constraints { + unix +} -body { + focusClear focusSetup update focus -lastfor .t.b2 -} {.t} -test focus-1.25 {Tk_FocusCmd procedure} unix { - list [catch {focus -unknown} msg] $msg -} {1 {bad option "-unknown": must be -displayof, -force, or -lastfor}} +} -result {.t} +test focus-1.25 {Tk_FocusCmd procedure} -constraints unix -body { + focus -unknown +} -returnCodes error -result {bad option "-unknown": must be -displayof, -force, or -lastfor} + -test focus-2.1 {TkFocusFilterEvent procedure} {unix nonPortable testwrapper} { +focusSetup +test focus-2.1 {TkFocusFilterEvent procedure} -constraints { + unix nonPortable testwrapper +} -body { + focusClear focus -force .b - destroy .t focusSetup update set focusInfo {} event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor \ -sendevent 0x54217567 - list $focusInfo -} {{}} -test focus-2.2 {TkFocusFilterEvent procedure} {unix nonPortable testwrapper} { + return $focusInfo +} -result {} +test focus-2.2 {TkFocusFilterEvent procedure} -constraints { + unix nonPortable testwrapper +} -body { + focusClear focus -force .b - destroy .t focusSetup update set focusInfo {} event gen .t <FocusIn> -detail NotifyAncestor -sendevent 0x547321ac list $focusInfo [focus] -} {{in .t NotifyAncestor +} -result {{in .t NotifyAncestor } .b} -test focus-2.3 {TkFocusFilterEvent procedure} {unix nonPortable testwrapper} { +test focus-2.3 {TkFocusFilterEvent procedure} -constraints { + unix nonPortable testwrapper +} -body { + focusClear focus -force .b - destroy .t focusSetup update set focusInfo {} event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor update list $focusInfo [focus -lastfor .t] -} {{out .b NotifyNonlinear +} -result {{out .b NotifyNonlinear out . NotifyNonlinearVirtual in .t NotifyNonlinear } .t} -test focus-2.4 {TkFocusFilterEvent procedure, FocusIn events} \ - {unix nonPortable testwrapper} { +test focus-2.4 {TkFocusFilterEvent procedure, FocusIn events} -constraints { + unix nonPortable testwrapper +} -body { + focusClear set result {} focus .t.b1 # Important to end with NotifyAncestor, which is an @@ -231,8 +280,8 @@ test focus-2.4 {TkFocusFilterEvent procedure, FocusIn events} \ update lappend result $focusInfo } - set result -} {{out . NotifyNonlinear + return $result +} -result {{out . NotifyNonlinear in .t NotifyNonlinearVirtual in .t.b1 NotifyNonlinear } {out . NotifyNonlinear @@ -245,19 +294,22 @@ in .t.b1 NotifyNonlinear in .t NotifyNonlinearVirtual in .t.b1 NotifyNonlinear }} -test focus-2.5 {TkFocusFilterEvent procedure, creating FocusInfo struct} \ - {unix nonPortable testwrapper} { +test focus-2.5 {TkFocusFilterEvent procedure, creating FocusInfo struct} -constraints { + unix nonPortable testwrapper +} -body { focusSetup focus .t.b1 update event gen [testwrapper .t] <FocusIn> -detail NotifyAncestor list $focusInfo [focus] -} {{out . NotifyNonlinear +} -result {{out . NotifyNonlinear in .t NotifyNonlinearVirtual in .t.b1 NotifyNonlinear } .t.b1} -test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} \ - {unix testwrapper} { + +test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} -constraints { + unix testwrapper +} -body { focus .t.b1 focus . update @@ -266,117 +318,131 @@ test focus-2.6 {TkFocusFilterEvent procedure, FocusIn events} \ set x [focus] event gen . <KeyPress-x> list $x $focusInfo -} {.t.b1 {press .t.b1 x}} -test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} \ - {unix testwrapper} { +} -result {.t.b1 {press .t.b1 x}} +test focus-2.7 {TkFocusFilterEvent procedure, FocusOut events} -constraints { + unix testwrapper +} -body { set result {} foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear NotifyNonlinearVirtual NotifyPointer NotifyPointerRoot NotifyVirtual} { - focus -force .t.b1 - event gen [testwrapper .t] <FocusOut> -detail $detail - update - lappend result [focus] + focus -force .t.b1 + event gen [testwrapper .t] <FocusOut> -detail $detail + update + lappend result [focus] } - set result -} {{} .t.b1 {} {} .t.b1 .t.b1 {}} -test focus-2.8 {TkFocusFilterEvent procedure, FocusOut events} \ - {unix testwrapper} { + return $result +} -result {{} .t.b1 {} {} .t.b1 .t.b1 {}} +test focus-2.8 {TkFocusFilterEvent procedure, FocusOut events} -constraints { + unix testwrapper +} -body { focus -force .t.b1 event gen .t.b1 <FocusOut> -detail NotifyAncestor focus -} {.t.b1} -test focus-2.9 {TkFocusFilterEvent procedure, FocusOut events} \ - {unix testwrapper} { +} -result {.t.b1} +test focus-2.9 {TkFocusFilterEvent procedure, FocusOut events} -constraints { + unix testwrapper +} -body { focus .t.b1 event gen [testwrapper .] <FocusOut> -detail NotifyAncestor focus -} {} -test focus-2.10 {TkFocusFilterEvent procedure, Enter events} \ - {unix testwrapper} { +} -result {} +test focus-2.10 {TkFocusFilterEvent procedure, Enter events} -constraints { + unix testwrapper +} -body { set result {} focus .t.b1 focusClear foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear - NotifyNonlinearVirtual NotifyVirtual} { - event gen [testwrapper .t] <Enter> -detail $detail -focus 1 - update - lappend result [focus] - event gen [testwrapper .t] <Leave> -detail NotifyAncestor - update + NotifyNonlinearVirtual NotifyVirtual} { + event gen [testwrapper .t] <Enter> -detail $detail -focus 1 + update + lappend result [focus] + event gen [testwrapper .t] <Leave> -detail NotifyAncestor + update } - set result -} {.t.b1 {} .t.b1 .t.b1 .t.b1} -test focus-2.11 {TkFocusFilterEvent procedure, Enter events} \ - {unix testwrapper} { + return $result +} -result {.t.b1 {} .t.b1 .t.b1 .t.b1} +test focus-2.11 {TkFocusFilterEvent procedure, Enter events} -constraints { + unix testwrapper +} -body { focusClear set focusInfo {} event gen [testwrapper .t] <Enter> -detail NotifyAncestor update - set focusInfo -} {} -test focus-2.12 {TkFocusFilterEvent procedure, Enter events} \ - {unix testwrapper} { + return $focusInfo +} -result {} +test focus-2.12 {TkFocusFilterEvent procedure, Enter events} -constraints { + unix testwrapper +} -body { focus -force .b update set focusInfo {} event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 update - set focusInfo -} {} -test focus-2.13 {TkFocusFilterEvent procedure, Enter events} \ - {unix testwrapper} { + return $focusInfo +} -result {} +test focus-2.13 {TkFocusFilterEvent procedure, Enter events} -constraints { + unix testwrapper +} -body { focus .t.b1 focusClear event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 set focusInfo {} update - set focusInfo -} {in .t NotifyVirtual + return $focusInfo +} -result {in .t NotifyVirtual in .t.b1 NotifyAncestor } -test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when setting focus due to implicit focus} {unix testwrapper} { +test focus-2.14 {TkFocusFilterEvent procedure, Enter events, ignore errors when setting focus due to implicit focus} -constraints { + unix testwrapper +} -setup { + destroy .t2 + set focusInfo {} +} -body { focusClear - catch {destroy .t2} toplevel .t2 wm withdraw .t2 update - set focusInfo {} event gen [testwrapper .t2] <Enter> -detail NotifyAncestor -focus 1 update +} -cleanup { destroy .t2 -} {} -test focus-2.15 {TkFocusFilterEvent procedure, Leave events} \ - {unix testwrapper} { +} -result {} +test focus-2.15 {TkFocusFilterEvent procedure, Leave events} -constraints { + unix testwrapper +} -body { set result {} focus .t.b1 foreach detail {NotifyAncestor NotifyInferior NotifyNonlinear NotifyNonlinearVirtual NotifyVirtual} { - focusClear - event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 - update - event gen [testwrapper .t] <Leave> -detail $detail - update - lappend result [focus] + focusClear + event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 + update + event gen [testwrapper .t] <Leave> -detail $detail + update + lappend result [focus] } - set result -} {{} .t.b1 {} {} {}} -test focus-2.16 {TkFocusFilterEvent procedure, Leave events} \ - {unix testwrapper} { - set result {} + return $result +} -result {{} .t.b1 {} {} {}} +test focus-2.16 {TkFocusFilterEvent procedure, Leave events} -constraints { + unix testwrapper +} -body { + focusClear focus .t.b1 event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 update set focusInfo {} event gen [testwrapper .t] <Leave> -detail NotifyAncestor update - set focusInfo -} {out .t.b1 NotifyAncestor + return $focusInfo +} -result {out .t.b1 NotifyAncestor out .t NotifyVirtual } -test focus-2.17 {TkFocusFilterEvent procedure, Leave events} \ - {unix testwrapper} { - set result {} +test focus-2.17 {TkFocusFilterEvent procedure, Leave events} -constraints { + unix testwrapper +} -body { + focusClear focus .t.b1 event gen [testwrapper .t] <Enter> -detail NotifyAncestor -focus 1 update @@ -385,41 +451,49 @@ test focus-2.17 {TkFocusFilterEvent procedure, Leave events} \ event gen [testwrapper .] <Leave> -detail NotifyAncestor update list $focusInfo [focus] -} {{out .t.b1 NotifyAncestor +} -result {{out .t.b1 NotifyAncestor out .t NotifyVirtual } {}} -test focus-3.1 {SetFocus procedure, create record on focus} \ - {unix testwrapper} { + +test focus-3.1 {SetFocus procedure, create record on focus} -constraints { + unix testwrapper +} -body { toplevel .t2 -width 250 -height 100 wm geometry .t2 +0+0 update focus -force .t2 update focus -} {.t2} -catch {destroy .t2} +} -cleanup { + destroy .t2 +} -result {.t2} # This test produces no result, but it will generate a protocol # error if Tk forgets to make the window exist before focussing # on it. -test focus-3.2 {SetFocus procedure, making window exist} {unix testwrapper} { +test focus-3.2 {SetFocus procedure, making window exist} -constraints { + unix testwrapper +} -body { update button .b2 -text "Another button" focus .b2 update -} {} -catch {destroy .b2} -update +} -cleanup { + destroy .b2 + update +} -result {} # The following test doesn't produce a check-able result, but if # there are bugs it may generate an X protocol error. -test focus-3.3 {SetFocus procedure, delaying claim of X focus} \ - {unix testwrapper} { +test focus-3.3 {SetFocus procedure, delaying claim of X focus} -constraints { + unix testwrapper +} -body { focusSetup focus -force .t.b2 update -} {} -test focus-3.4 {SetFocus procedure, delaying claim of X focus} \ - {unix testwrapper} { +} -result {} +test focus-3.4 {SetFocus procedure, delaying claim of X focus} -constraints { + unix testwrapper +} -body { focusSetup wm withdraw .t focus -force .t.b2 @@ -430,52 +504,62 @@ test focus-3.4 {SetFocus procedure, delaying claim of X focus} \ update wm deiconify .t2 wm deiconify .t -} {} -catch {destroy .t2} -test focus-3.5 {SetFocus procedure, generating events} {unix testwrapper} { +} -cleanup { + destroy .t2 +} -result {} +test focus-3.5 {SetFocus procedure, generating events} -constraints { + unix testwrapper +} -body { focusSetup focusClear set focusInfo {} focus -force .t.b2 update - set focusInfo -} {in .t NotifyVirtual + return $focusInfo +} -result {in .t NotifyVirtual in .t.b2 NotifyAncestor } -test focus-3.6 {SetFocus procedure, generating events} {unix testwrapper} { +test focus-3.6 {SetFocus procedure, generating events} -constraints { + unix testwrapper +} -body { focusSetup focus -force .b update set focusInfo {} focus .t.b2 update - set focusInfo -} {out .b NotifyNonlinear + return $focusInfo +} -result {out .b NotifyNonlinear out . NotifyNonlinearVirtual in .t NotifyNonlinearVirtual in .t.b2 NotifyNonlinear } -test focus-3.7 {SetFocus procedure, generating events} \ - {unix nonPortable testwrapper} { +test focus-3.7 {SetFocus procedure, generating events} -constraints { +unix nonPortable testwrapper +} -body { # Non-portable because some platforms generate extra events. - focusSetup focusClear set focusInfo {} focus .t.b2 update - set focusInfo -} {} + return $focusInfo +} -result {} + -test focus-4.1 {TkFocusDeadWindow procedure} {unix testwrapper} { +test focus-4.1 {TkFocusDeadWindow procedure} -constraints { + unix testwrapper +} -body { focusSetup update focus -force .b update destroy .t focus -} {.b} -test focus-4.2 {TkFocusDeadWindow procedure} {unix testwrapper} { +} -result {.b} +test focus-4.2 {TkFocusDeadWindow procedure} -constraints { + unix testwrapper +} -body { focusSetup update focus -force .t.b2 @@ -484,12 +568,12 @@ test focus-4.2 {TkFocusDeadWindow procedure} {unix testwrapper} { destroy .t.b2 update focus -} {.b} - +} -result {.b} # Non-portable due to wm-specific redirection of input focus when # windows are deleted: - -test focus-4.3 {TkFocusDeadWindow procedure} {unix nonPortable testwrapper} { +test focus-4.3 {TkFocusDeadWindow procedure} -constraints { + unix nonPortable testwrapper +} -body { focusSetup update focus .t @@ -497,21 +581,27 @@ test focus-4.3 {TkFocusDeadWindow procedure} {unix nonPortable testwrapper} { destroy .t update focus -} {} -test focus-4.4 {TkFocusDeadWindow procedure} {unix testwrapper} { +} -result {} +test focus-4.4 {TkFocusDeadWindow procedure} -constraints { + unix testwrapper +} -body { focusSetup focus -force .t.b2 update destroy .t.b2 focus -} {.t} +} -result {.t} +cleanupbg + # I don't know how to test most of the remaining procedures of this file # explicitly; they've already been exercised by the preceding tests. -setupbg -test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} \ - {unix testwrapper secureserver} { +# Test 5.1 fails (before and after update) +test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} -constraints { + unix testwrapper secureserver +} -body { + setupbg focusSetup focus -force .t update @@ -521,19 +611,21 @@ test focus-5.1 {ChangeXFocus procedure, don't take focus unless have it} \ focus .t.b2 update lappend result [focus] -} {.t {} {}} - -catch {destroy .t} +} -cleanup { + cleanupbg +} -result {.t {} {}} +destroy .t bind all <FocusIn> {} bind all <FocusOut> {} bind all <KeyPress> {} -cleanupbg -fixfocus -test focus-6.1 {miscellaneous - embedded application in same process} \ - {unix testwrapper} { + +fixfocus +test focus-6.1 {miscellaneous - embedded application in same process} -constraints { + unix testwrapper +} -setup { eval interp delete [interp slaves] - catch {destroy .t} +} -body { toplevel .t wm geometry .t +0+0 frame .t.f1 -container 1 @@ -547,11 +639,11 @@ test focus-6.1 {miscellaneous - embedded application in same process} \ child eval "set argv {-use [winfo id .t.f1]}" load {} Tk child child eval { - entry .e1 -bg lightBlue - pack .e1 - bind all <FocusIn> {lappend x "focus in %W %d"} - bind all <FocusOut> {lappend x "focus out %W %d"} - set x {} + entry .e1 -bg lightBlue + pack .e1 + bind all <FocusIn> {lappend x "focus in %W %d"} + bind all <FocusOut> {lappend x "focus out %W %d"} + set x {} } # Claim the focus and wait long enough for it to really arrive. @@ -577,13 +669,17 @@ test focus-6.1 {miscellaneous - embedded application in same process} \ after 300 {set timer 1} vwait timer set result [list $x [child eval {set x}]] + return $result +} -cleanup { interp delete child - set result -} {{.t.f2.e1 {} {focus out .t.f2.e1 NotifyNonlinear} {focus out .t.f2 NotifyNonlinearVirtual} {focus in .t.f1 NotifyNonlinear} | {focus out .t.f1 NotifyNonlinear} {focus in .t.f2 NotifyNonlinearVirtual} {focus in .t.f2.e1 NotifyNonlinear}} {{focus in . NotifyVirtual} {focus in .e1 NotifyAncestor} | {focus out .e1 NotifyAncestor} {focus out . NotifyVirtual}}} -test focus-6.2 {miscellaneous - embedded application in different process} \ - {unix testwrapper} { - eval interp delete [interp slaves] - catch {destroy .t} + destroy .t + bind all <FocusIn> {} + bind all <FocusOut> {} +} -result {{.t.f2.e1 {} {focus out .t.f2.e1 NotifyNonlinear} {focus out .t.f2 NotifyNonlinearVirtual} {focus in .t.f1 NotifyNonlinear} | {focus out .t.f1 NotifyNonlinear} {focus in .t.f2 NotifyNonlinearVirtual} {focus in .t.f2.e1 NotifyNonlinear}} {{focus in . NotifyVirtual} {focus in .e1 NotifyAncestor} | {focus out .e1 NotifyAncestor} {focus out . NotifyVirtual}}} + +test focus-6.2 {miscellaneous - embedded application in different process} -constraints { + unix testwrapper +} -body { setupbg toplevel .t wm geometry .t +0+0 @@ -596,11 +692,11 @@ test focus-6.2 {miscellaneous - embedded application in different process} \ bind all <FocusOut> {lappend x "focus out %W %d"} setupbg -use [winfo id .t.f1] dobg { - entry .e1 -bg lightBlue - pack .e1 - bind all <FocusIn> {lappend x "focus in %W %d"} - bind all <FocusOut> {lappend x "focus out %W %d"} - set x {} + entry .e1 -bg lightBlue + pack .e1 + bind all <FocusIn> {lappend x "focus in %W %d"} + bind all <FocusOut> {lappend x "focus out %W %d"} + set x {} } # Claim the focus and wait long enough for it to really arrive. @@ -626,13 +722,17 @@ test focus-6.2 {miscellaneous - embedded application in different process} \ after 300 {set timer 1} vwait timer set result [list $x [dobg {set x}]] + return $result +} -cleanup { + destroy .t cleanupbg - set result -} {{.t.f2.e1 {} {focus out .t.f2.e1 NotifyNonlinear} {focus out .t.f2 NotifyNonlinearVirtual} {focus in .t.f1 NotifyNonlinear} | {focus out .t.f1 NotifyNonlinear} {focus in .t.f2 NotifyNonlinearVirtual} {focus in .t.f2.e1 NotifyNonlinear}} {{focus in . NotifyVirtual} {focus in .e1 NotifyAncestor} | {focus out .e1 NotifyAncestor} {focus out . NotifyVirtual}}} + bind all <FocusIn> {} + bind all <FocusOut> {} +} -result {{.t.f2.e1 {} {focus out .t.f2.e1 NotifyNonlinear} {focus out .t.f2 NotifyNonlinearVirtual} {focus in .t.f1 NotifyNonlinear} | {focus out .t.f1 NotifyNonlinear} {focus in .t.f2 NotifyNonlinearVirtual} {focus in .t.f2.e1 NotifyNonlinear}} {{focus in . NotifyVirtual} {focus in .e1 NotifyAncestor} | {focus out .e1 NotifyAncestor} {focus out . NotifyVirtual}}} + + deleteWindows -bind all <FocusIn> {} -bind all <FocusOut> {} # cleanup cleanupTests |