diff options
Diffstat (limited to 'tests/pack.test')
-rw-r--r-- | tests/pack.test | 134 |
1 files changed, 101 insertions, 33 deletions
diff --git a/tests/pack.test b/tests/pack.test index 9fd8035..02008c7 100644 --- a/tests/pack.test +++ b/tests/pack.test @@ -1,5 +1,5 @@ -# This file is a Tcl script to test out the "pack" command -# of Tk. It is organized in the standard fashion for Tcl tests. +# This file is a Tcl script to test out the "pack" command of Tk. It is +# organized in the standard fashion for Tcl tests. # # Copyright (c) 1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. @@ -29,7 +29,7 @@ foreach i {a b c d} { .pack.b config -width 50 -height 30 .pack.c config -width 80 -height 80 .pack.d config -width 40 -height 30 - + test pack-1.1 {-side option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -232,7 +232,6 @@ test pack-2.21 {x padding and filling} -setup { update list [winfo geometry .pack.a] [winfo geometry .pack.b] } -result {280x40+5+0 300x160+0+40} - test pack-2.22 {x padding and filling} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -252,7 +251,6 @@ test pack-2.23 {x padding and filling} -setup { expr {$res1 eq $res2} } -result 1 - test pack-3.1 {y padding and filling} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -421,7 +419,6 @@ test pack-3.21 {y padding and filling} -setup { update list [winfo geometry .pack.a] [winfo geometry .pack.b] } -result {20x50+140+1 300x130+0+70} - test pack-3.22 {y padding and filling} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -441,7 +438,6 @@ test pack-3.23 {y padding and filling} -setup { expr {$res1 eq $res2} } -result 1 - test pack-4.1 {anchors} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -506,7 +502,6 @@ test pack-4.9 {anchors} -setup { winfo geometry .pack.a } -result {30x70+135+65} - # Repeat above tests, but with a frame that isn't at (0,0), so that # we can be sure that the frame offset is being added in correctly. @@ -592,7 +587,6 @@ test pack-5.9 {more anchors} -setup { winfo geometry .pack.b } -result {60x60+160+90} - test pack-6.1 {-expand option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -698,7 +692,6 @@ test pack-6.11 {-expand option} -setup { list [winfo geometry .pack.a] [winfo geometry .pack.b] \ [winfo geometry .pack.c] [winfo geometry .pack.d] } -result {100x200+0+0 200x100+100+0 160x100+140+100 40x100+100+100} - test pack-6.12 {-expand option} -setup { toplevel .pack2 -height 400 -width 400 wm geometry .pack2 +0+0 @@ -733,7 +726,6 @@ test pack-6.13 {-expand option} -setup { destroy .pack2 } -result {38x42+181+45 38x42+181+178 38x42+181+312} - wm geometry .pack {} test pack-7.1 {requesting size for parent} -setup { pack forget .pack.a .pack.b .pack.c .pack.d @@ -792,7 +784,6 @@ test pack-7.7 {requesting size for parent} -setup { list [winfo reqwidth .pack] [winfo reqheight .pack] } -result {100 110} - # For the tests below, create a couple of "pad" windows to shrink # the available space for the remaining windows. The tests have to # be done this way rather than shrinking the whole window, because @@ -873,7 +864,6 @@ test pack-8.9 {insufficient space} -body { } -result {20x40+0+20 1 50x30+100+25 1 80x80+20+0 1} pack forget .pack.right .pack.bottom - test pack-9.1 {window ordering} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -946,7 +936,6 @@ test pack-9.10 {window ordering} -setup { pack content .pack } -result {.pack.a .pack.c .pack.d .pack.b} - test pack-10.1 {retaining/clearing configuration state} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -976,7 +965,7 @@ test pack-10.4 {bad -in window does not change container window} -setup { } -body { winfo manager .pack.a pack .pack.a -in .pack.a -} -returnCodes error -result {can't pack .pack.a inside itself} +} -returnCodes error -result {can't pack ".pack.a" inside itself} test pack-10.5 {prevent management loops} -body { frame .f1 frame .f2 @@ -985,7 +974,7 @@ test pack-10.5 {prevent management loops} -body { } -cleanup { destroy .f1 destroy .f2 -} -returnCodes error -result {can't put .f2 inside .f1, would cause management loop} +} -returnCodes error -result {can't put ".f2" inside ".f1": would cause management loop} test pack-10.6 {prevent management loops} -body { frame .f1 frame .f2 @@ -997,8 +986,7 @@ test pack-10.6 {prevent management loops} -body { destroy .f1 destroy .f2 destroy .f3 -} -returnCodes error -result {can't put .f3 inside .f1, would cause management loop} - +} -returnCodes error -result {can't put ".f3" inside ".f1": would cause management loop} test pack-11.1 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d @@ -1134,7 +1122,6 @@ test pack-11.19 {info option} -setup { lindex $i [expr [lsearch -exact $i -side]+1] } -result right - test pack-12.1 {command options and errors} -body { pack } -returnCodes error -result {wrong # args: should be "pack option arg ?arg ...?"} @@ -1295,18 +1282,18 @@ test pack-12.33 {command options and errors} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { pack .pack.a -in . -} -returnCodes error -result {can't pack .pack.a inside .} +} -returnCodes error -result {can't pack ".pack.a" inside "."} test pack-12.34 {command options and errors} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { frame .pack.a.a pack .pack.a.a -in .pack.b -} -returnCodes error -result {can't pack .pack.a.a inside .pack.b} +} -returnCodes error -result {can't pack ".pack.a.a" inside ".pack.b"} test pack-12.35 {command options and errors} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { pack .pack.a -in .pack.a -} -returnCodes error -result {can't pack .pack.a inside itself} +} -returnCodes error -result {can't pack ".pack.a" inside itself} test pack-12.36 {command options and errors} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -1374,8 +1361,7 @@ test pack-12.46 {command options and errors} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { pack lousy .pack -} -returnCodes error -result {bad option "lousy": must be configure, content, forget, info, propagate, or slaves} - +} -returnCodes error -match glob -result {bad option "lousy": must be configure, content, forget, info, *propagate*} test pack-13.1 {window deletion} -setup { pack forget .pack.a .pack.b .pack.c .pack.d .pack.right .pack.bottom @@ -1390,7 +1376,6 @@ test pack-13.1 {window deletion} -setup { [winfo geometry .pack.b] [winfo geometry .pack.c]] } -result {{.pack.right .pack.bottom .pack.a .pack.b .pack.c} 20x40+30+0 50x30+15+40 80x80+0+70} - test pack-14.1 {respond to changes in expansion} -setup { pack forget .pack.a .pack.b .pack.c .pack.d .pack.right .pack.bottom } -body { @@ -1516,7 +1501,6 @@ test pack-15.5 {managing geometry with -in option} -setup { destroy .pack.f1 .pack.f2 } -result {50x16+25+22 1 50x16+25+22 0} - test pack-16.1 {geometry manager name} -setup { pack forget .pack.a .pack.b .pack.c .pack.d set result {} @@ -1528,7 +1512,6 @@ test pack-16.1 {geometry manager name} -setup { lappend result [winfo manager .pack.a] } -result {{} pack {}} - test pack-17.1 {PackLostContentProc procedure} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -1564,7 +1547,6 @@ test pack-18.1 {unmap content when container unmapped} -constraints { } -setup { eval destroy [winfo child .pack] } -body { - # adjust the position of .pack before test to avoid a screen switch # that occurs with window managers that have desktops four times as big # as the screen (screen switch causes scale and other tests to fail). @@ -1594,7 +1576,6 @@ test pack-18.1 {unmap content when container unmapped} -constraints { test pack-18.2 {unmap content when container unmapped} -constraints failsOnUbuntu -setup { eval destroy [winfo child .pack] } -body { - # adjust the position of .pack before test to avoid a screen switch # that occurs with window managers that have desktops four times as big # as the screen (screen switch causes scale and other tests to fail). @@ -1617,7 +1598,6 @@ test pack-18.2 {unmap content when container unmapped} -constraints failsOnUbunt lappend result [winfo ismapped .pack.b] } -result {1 0 100 30 0 1} - test pack-19.1 {test respect for internalborder} -setup { catch {eval pack forget [pack content .pack]} destroy .pack.l .pack.lf @@ -1655,10 +1635,98 @@ test pack-19.2 {test support for minreqsize} -setup { destroy .pack.l .pack.lf } -result {162x127+0+0 172x112+0+0} - +test pack-20.1 {<<NoManagedChild>> fires on last pack forget} -setup { + global A + unset -nocomplain A +} -body { + pack [frame .1] + update + bind . <<NoManagedChild>> {set A 1} + pack forget .1 + update + info exists A +} -cleanup { + bind . <<NoManagedChild>> {} + destroy .1 +} -result 1 +test pack-20.2 {<<NoManagedChild>> fires on last packed child destruction} -setup { + global A + unset -nocomplain A +} -body { + pack [frame .1] + update + bind . <<NoManagedChild>> {incr A} + destroy .1 + update + set A +} -cleanup { + bind . <<NoManagedChild>> {} + destroy .1 +} -result 1 +test pack-20.3 {<Configure> does not fire on last pack forget} -setup { + global A + unset -nocomplain A +} -body { + pack [frame .1] + update + bind . <Configure> {set A 1} + pack forget .1 + update + info exists A +} -cleanup { + bind . <Configure> {} + destroy .1 +} -result 0 +test pack-20.4 {<<NoManagedChild>> does not fire on forelast pack forget} -setup { + global A + unset -nocomplain A +} -body { + pack [frame .1] + pack [frame .2] + update + bind . <<NoManagedChild>> {set A 1} + pack forget .1 + update + info exists A +} -cleanup { + bind . <<NoManagedChild>> {} + destroy .1 .2 +} -result 0 +test pack-20.5 {<Configure> does not fire on last pack forget} -setup { + global A + unset -nocomplain A +} -body { + pack [frame .1] + pack [frame .2] + update + bind . <Configure> {set A 1} + pack forget .1 + update + info exists A +} -cleanup { + bind . <Configure> {} + destroy .1 .2 +} -result 1 +test pack-20.6 {<<NoManagedChild>> does not fire on last pack forget if propagation is off} -setup { + global A + unset -nocomplain A +} -body { + pack [frame .1] + pack propagate . 0 + update + bind . <<NoManagedChild>> {set A 1} + pack forget .1 + update + info exists A +} -cleanup { + bind . <<NoManagedChild>> {} + destroy .1 +} -result 0 + # cleanup cleanupTests return - - +# Local Variables: +# mode: tcl +# End: |