diff options
Diffstat (limited to 'tests/raise.test')
| -rw-r--r-- | tests/raise.test | 203 |
1 files changed, 118 insertions, 85 deletions
diff --git a/tests/raise.test b/tests/raise.test index cdd525d..2431264 100644 --- a/tests/raise.test +++ b/tests/raise.test @@ -8,21 +8,22 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: raise.test,v 1.10 2004/06/17 22:38:57 dkf Exp $ +# RCS: @(#) $Id: raise.test,v 1.11 2008/08/18 16:09:10 aniap Exp $ -package require tcltest 2.1 +package require tcltest 2.2 eval tcltest::configure $argv tcltest::loadTestedCommands +namespace import -force tcltest::test # Procedure to create a bunch of overlapping windows, which should # make it easy to detect differences in order. proc raise_setup {} { foreach i [winfo child .raise] { - destroy $i - } + destroy $i + } foreach i {a b c d e} { - label .raise.$i -text $i -relief raised -bd 2 + label .raise.$i -text $i -relief raised -bd 2 } place .raise.a -x 20 -y 60 -width 60 -height 80 place .raise.b -x 60 -y 60 -width 60 -height 80 @@ -61,149 +62,173 @@ proc raise_makeToplevels {} { toplevel .raise wm geom .raise 250x200+0+0 -test raise-1.1 {preserve creation order} { + +test raise-1.1 {preserve creation order} -body { raise_setup tkwait visibility .raise.e raise_getOrder -} {d d d b c e e e} -test raise-1.2 {preserve creation order} testmakeexist { +} -result {d d d b c e e e} +test raise-1.2 {preserve creation order} -constraints testmakeexist -body { raise_setup testmakeexist .raise.a update raise_getOrder -} {d d d b c e e e} -test raise-1.3 {preserve creation order} testmakeexist { +} -result {d d d b c e e e} +test raise-1.3 {preserve creation order} -constraints testmakeexist -body { raise_setup testmakeexist .raise.c update raise_getOrder -} {d d d b c e e e} -test raise-1.4 {preserve creation order} testmakeexist { +} -result {d d d b c e e e} +test raise-1.4 {preserve creation order} -constraints testmakeexist -body { raise_setup testmakeexist .raise.e update raise_getOrder -} {d d d b c e e e} -test raise-1.5 {preserve creation order} testmakeexist { +} -result {d d d b c e e e} +test raise-1.5 {preserve creation order} -constraints testmakeexist -body { raise_setup testmakeexist .raise.d .raise.c .raise.b update raise_getOrder -} {d d d b c e e e} +} -result {d d d b c e e e} -test raise-2.1 {raise internal windows before creation} { + +test raise-2.1 {raise internal windows before creation} -body { raise_setup raise .raise.a update raise_getOrder -} {a d d a c a e e} -test raise-2.2 {raise internal windows before creation} { +} -result {a d d a c a e e} +test raise-2.2 {raise internal windows before creation} -body { raise_setup raise .raise.c update raise_getOrder -} {d d c b c e e c} -test raise-2.3 {raise internal windows before creation} { +} -result {d d c b c e e c} +test raise-2.3 {raise internal windows before creation} -body { raise_setup raise .raise.e update raise_getOrder -} {d d d b c e e e} -test raise-2.4 {raise internal windows before creation} { +} -result {d d d b c e e e} +test raise-2.4 {raise internal windows before creation} -body { raise_setup raise .raise.e .raise.a update raise_getOrder -} {d d d b c e b c} -test raise-2.5 {raise internal windows before creation} { +} -result {d d d b c e b c} +test raise-2.5 {raise internal windows before creation} -body { raise_setup raise .raise.a .raise.d update raise_getOrder -} {a d d a c e e e} +} -result {a d d a c e e e} + -test raise-3.1 {raise internal windows after creation} { +test raise-3.1 {raise internal windows after creation} -body { raise_setup update raise .raise.a .raise.d raise_getOrder -} {a d d a c e e e} -test raise-3.2 {raise internal windows after creation} testmakeexist { +} -result {a d d a c e e e} +test raise-3.2 {raise internal windows after creation} -constraints { + testmakeexist +} -body { raise_setup testmakeexist .raise.a .raise.b raise .raise.a .raise.b update raise_getOrder -} {d d d a c e e e} -test raise-3.3 {raise internal windows after creation} testmakeexist { +} -result {d d d a c e e e} +test raise-3.3 {raise internal windows after creation} -constraints { + testmakeexist +} -body { raise_setup testmakeexist .raise.a .raise.d raise .raise.a .raise.b update raise_getOrder -} {d d d a c e e e} -test raise-3.4 {raise internal windows after creation} testmakeexist { +} -result {d d d a c e e e} +test raise-3.4 {raise internal windows after creation} -constraints { + testmakeexist +} -body { raise_setup testmakeexist .raise.a .raise.c .raise.d raise .raise.a .raise.b update raise_getOrder -} {d d d a c e e e} +} -result {d d d a c e e e} -test raise-4.1 {raise relative to nephews} { + +test raise-4.1 {raise relative to nephews} -body { raise_setup update frame .raise.d.child raise .raise.a .raise.d.child raise_getOrder -} {a d d a c e e e} -test raise-4.2 {raise relative to nephews} { +} -result {a d d a c e e e} +test raise-4.2 {raise relative to nephews} -setup { + destroy .raise2 +} -body { raise_setup update frame .raise2 - list [catch {raise .raise.a .raise2} msg] $msg -} {1 {can't raise ".raise.a" above ".raise2"}} -catch {destroy .raise2} + raise .raise.a .raise2 +} -cleanup { + destroy .raise2 +} -returnCodes error -result {can't raise ".raise.a" above ".raise2"} -test raise-5.1 {lower internal windows} { + +test raise-5.1 {lower internal windows} -body { raise_setup update lower .raise.d raise_getOrder -} {a b c b c e e e} -test raise-5.2 {lower internal windows} { +} -result {a b c b c e e e} +test raise-5.2 {lower internal windows} -body { raise_setup update lower .raise.d .raise.b raise_getOrder -} {d b c b c e e e} -test raise-5.3 {lower internal windows} { +} -result {d b c b c e e e} +test raise-5.3 {lower internal windows} -body { raise_setup update lower .raise.a .raise.e raise_getOrder -} {a d d a c e e e} -test raise-5.4 {lower internal windows} { +} -result {a d d a c e e e} +test raise-5.4 {lower internal windows} -setup { + destroy .raise2 +} -body { raise_setup update frame .raise2 - list [catch {lower .raise.a .raise2} msg] $msg -} {1 {can't lower ".raise.a" below ".raise2"}} -catch {destroy .raise2} + lower .raise.a .raise2 +} -cleanup { + destroy .raise2 +} -returnCodes error -result {can't lower ".raise.a" below ".raise2"} -test raise-6.1 {raise/lower toplevel windows} {nonPortable} { + +test raise-6.1 {raise/lower toplevel windows} -constraints { + nonPortable +} -body { raise_makeToplevels update raise .raise1 winfo containing [winfo rootx .raise1] [winfo rooty .raise1] -} .raise1 -test raise-6.2 {raise/lower toplevel windows} {nonPortable} { +} -result {.raise1} +test raise-6.2 {raise/lower toplevel windows} -constraints { + nonPortable +} -body { raise_makeToplevels update raise .raise2 winfo containing [winfo rootx .raise1] [winfo rooty .raise1] -} .raise2 -test raise-6.3 {raise/lower toplevel windows} {nonPortable} { +} -result {.raise2} +test raise-6.3 {raise/lower toplevel windows} -constraints { + nonPortable +} -body { raise_makeToplevels update raise .raise3 @@ -216,8 +241,10 @@ test raise-6.3 {raise/lower toplevel windows} {nonPortable} { after 500 list $result [winfo containing [winfo rootx .raise1] \ [winfo rooty .raise1]] -} {.raise2 .raise1} -test raise-6.4 {raise/lower toplevel windows} {nonPortable} { +} -result {.raise2 .raise1} +test raise-6.4 {raise/lower toplevel windows} -constraints { + nonPortable +} -body { raise_makeToplevels update raise .raise2 @@ -232,14 +259,18 @@ test raise-6.4 {raise/lower toplevel windows} {nonPortable} { after 500 list $result [winfo containing [winfo rootx .raise2] \ [winfo rooty .raise2]] -} {.raise1 .raise3} -test raise-6.5 {raise/lower toplevel windows} {nonPortable} { +} -result {.raise1 .raise3} +test raise-6.5 {raise/lower toplevel windows} -constraints { + nonPortable +} -body { raise_makeToplevels raise .raise1 set time [lindex [time {raise .raise1}] 0] expr {$time < 2000000} -} 1 -test raise-6.6 {raise/lower toplevel windows} {nonPortable} { +} -result 1 +test raise-6.6 {raise/lower toplevel windows} -constraints { + nonPortable +} -body { raise_makeToplevels update raise .raise2 @@ -255,35 +286,37 @@ test raise-6.6 {raise/lower toplevel windows} {nonPortable} { after 500 list $result [winfo containing [winfo rootx .raise2] \ [winfo rooty .raise2]] -} {.raise1 .raise3} +} -result {.raise1 .raise3} + -test raise-7.1 {errors in raise/lower commands} { - list [catch {raise} msg] $msg -} {1 {wrong # args: should be "raise window ?aboveThis?"}} -test raise-7.2 {errors in raise/lower commands} { - list [catch {raise a b c} msg] $msg -} {1 {wrong # args: should be "raise window ?aboveThis?"}} -test raise-7.3 {errors in raise/lower commands} { - list [catch {raise badName} msg] $msg -} {1 {bad window path name "badName"}} -test raise-7.4 {errors in raise/lower commands} { - list [catch {raise . badName2} msg] $msg -} {1 {bad window path name "badName2"}} -test raise-7.5 {errors in raise/lower commands} { - list [catch {lower} msg] $msg -} {1 {wrong # args: should be "lower window ?belowThis?"}} -test raise-7.6 {errors in raise/lower commands} { - list [catch {lower a b c} msg] $msg -} {1 {wrong # args: should be "lower window ?belowThis?"}} -test raise-7.7 {errors in raise/lower commands} { - list [catch {lower badName3} msg] $msg -} {1 {bad window path name "badName3"}} -test raise-7.8 {errors in raise/lower commands} { - list [catch {lower . badName4} msg] $msg -} {1 {bad window path name "badName4"}} +test raise-7.1 {errors in raise/lower commands} -body { + raise +} -returnCodes error -result {wrong # args: should be "raise window ?aboveThis?"} +test raise-7.2 {errors in raise/lower commands} -body { + raise a b c +} -returnCodes error -result {wrong # args: should be "raise window ?aboveThis?"} +test raise-7.3 {errors in raise/lower commands} -body { + raise badName +} -returnCodes error -result {bad window path name "badName"} +test raise-7.4 {errors in raise/lower commands} -body { + raise . badName2 +} -returnCodes error -result {bad window path name "badName2"} +test raise-7.5 {errors in raise/lower commands} -body { + lower +} -returnCodes error -result {wrong # args: should be "lower window ?belowThis?"} +test raise-7.6 {errors in raise/lower commands} -body { + lower a b c +} -returnCodes error -result {wrong # args: should be "lower window ?belowThis?"} +test raise-7.7 {errors in raise/lower commands} -body { + lower badName3 +} -returnCodes error -result {bad window path name "badName3"} +test raise-7.8 {errors in raise/lower commands} -body { + lower . badName4 +} -returnCodes error -result {bad window path name "badName4"} deleteWindows # cleanup cleanupTests return + |