From 4242adeaa1ea33a9701e15b6a1861511f9d28be5 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 6 Nov 2018 14:40:47 +0000 Subject: Tidy up tests --- tests/grid.test | 42 +++++++++++++++++++++---------------- tests/pack.test | 65 ++++++++++++++++++++++----------------------------------- 2 files changed, 49 insertions(+), 58 deletions(-) diff --git a/tests/grid.test b/tests/grid.test index 444f60f..63bfe2a 100644 --- a/tests/grid.test +++ b/tests/grid.test @@ -1800,7 +1800,6 @@ test grid-17.1 {forget and pending idle handlers} -body { set result ok } -result ok - test grid-18.1 {test respect for internalborder} -body { toplevel .pack wm geometry .pack 200x200 @@ -2018,9 +2017,10 @@ test grid-23 {grid configure -in leaked from previous master - bug } {1} grid_reset 23 -test grid-24.1 {<> fires on last grid forget} -body { +test grid-24.1 {<> fires on last grid forget} -setup { global A - catch {unset A} + unset -nocomplain A +} -body { grid [frame .1] update bind . <> {set A 1} @@ -2031,9 +2031,10 @@ test grid-24.1 {<> fires on last grid forget} -body { bind . <> {} grid_reset 24.1 } -result {1} -test grid-24.2 {<> fires on last grid remove} -body { +test grid-24.2 {<> fires on last grid remove} -setup { global A - catch {unset A} + unset -nocomplain A +} -body { grid [frame .1] update bind . <> {set A 1} @@ -2044,9 +2045,10 @@ test grid-24.2 {<> fires on last grid remove} -body { bind . <> {} grid_reset 24.2 } -result {1} -test grid-24.3 {<> fires on last gridded child destruction} -body { +test grid-24.3 {<> fires on last gridded child destruction} -setup { global A - catch {unset A} + unset -nocomplain A +} -body { grid [frame .1] update bind . <> {incr A} @@ -2057,9 +2059,10 @@ test grid-24.3 {<> fires on last gridded child destruction} -bod bind . <> {} grid_reset 24.3 } -result {1} -test grid-24.4 { does not fire on last grid forget} -body { +test grid-24.4 { does not fire on last grid forget} -setup { global A - catch {unset A} + unset -nocomplain A +} -body { grid [frame .1] update bind . {set A 1} @@ -2070,9 +2073,10 @@ test grid-24.4 { does not fire on last grid forget} -body { bind . {} grid_reset 24.4 } -result {0} -test grid-24.5 { fires on forelast grid forget} -body { +test grid-24.5 { fires on forelast grid forget} -setup { global A - catch {unset A} + unset -nocomplain A +} -body { grid [frame .1] grid [frame .2] update @@ -2084,9 +2088,10 @@ test grid-24.5 { fires on forelast grid forget} -body { bind . {} grid_reset 24.5 } -result {1} -test grid-24.6 {<> does not fire on forelast grid forget} -body { +test grid-24.6 {<> does not fire on forelast grid forget} -setup { global A - catch {unset A} + unset -nocomplain A +} -body { grid [frame .1] grid [frame .2] update @@ -2098,9 +2103,10 @@ test grid-24.6 {<> does not fire on forelast grid forget} -body bind . <> {} grid_reset 24.6 } -result {0} -test grid-24.7 {<> does not fire on grid anchor} -body { +test grid-24.7 {<> does not fire on grid anchor} -setup { global A - catch {unset A} + unset -nocomplain A +} -body { bind . <> {set A 1} grid anchor . w update @@ -2110,9 +2116,10 @@ test grid-24.7 {<> does not fire on grid anchor} -body { bind . <> {} grid_reset 24.7 } -result {0} -test grid-24.8 {<> does not fire on last grid forget if propagation is off} -body { +test grid-24.8 {<> does not fire on last grid forget if propagation is off} -setup { global A - catch {unset A} + unset -nocomplain A +} -body { grid [frame .1] grid propagate . 0 update @@ -2124,7 +2131,6 @@ test grid-24.8 {<> does not fire on last grid forget if propagat bind . <> {} grid_reset 24.8 } -result {0} - # cleanup cleanupTests diff --git a/tests/pack.test b/tests/pack.test index 22b5cbb..9d5964c 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. @@ -28,7 +28,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 { @@ -231,7 +231,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 { @@ -251,7 +250,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 { @@ -420,7 +418,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 { @@ -440,7 +437,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 { @@ -505,7 +501,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. @@ -591,7 +586,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 { @@ -697,7 +691,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 @@ -732,7 +725,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 @@ -791,7 +783,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 @@ -872,7 +863,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 { @@ -945,7 +935,6 @@ test pack-9.10 {window ordering} -setup { pack slaves .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 { @@ -977,7 +966,6 @@ test pack-10.4 {bad -in window does not change master} -setup { pack .pack.a -in .pack.a } -returnCodes error -result {can't pack .pack.a inside itself} - test pack-11.1 {info option} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -1112,7 +1100,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 ...?"} @@ -1354,7 +1341,6 @@ test pack-12.46 {command options and errors} -setup { pack lousy .pack } -returnCodes error -result {bad option "lousy": must be configure, forget, info, propagate, or slaves} - test pack-13.1 {window deletion} -setup { pack forget .pack.a .pack.b .pack.c .pack.d .pack.right .pack.bottom } -body { @@ -1368,7 +1354,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 { @@ -1494,7 +1479,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 {} @@ -1506,7 +1490,6 @@ test pack-16.1 {geometry manager name} -setup { lappend result [winfo manager .pack.a] } -result {{} pack {}} - test pack-17.1 {PackLostSlaveProc procedure} -setup { pack forget .pack.a .pack.b .pack.c .pack.d } -body { @@ -1528,13 +1511,11 @@ test pack-17.2 {PackLostSlaveProc procedure} -setup { pack info .pack.a } -returnCodes error -result {window ".pack.a" isn't packed} - test pack-18.1 {unmap slaves when master unmapped} -constraints { tempNotPc } -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). @@ -1564,7 +1545,6 @@ test pack-18.1 {unmap slaves when master unmapped} -constraints { test pack-18.2 {unmap slaves when master unmapped} -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). @@ -1588,7 +1568,6 @@ test pack-18.2 {unmap slaves when master unmapped} -setup { 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 slaves .pack]} destroy .pack.l .pack.lf @@ -1626,9 +1605,10 @@ 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 {<> fires on last pack forget} -body { +test pack-20.1 {<> fires on last pack forget} -setup { global A - catch {unset A} + unset -nocomplain A +} -body { pack [frame .1] update bind . <> {set A 1} @@ -1639,9 +1619,10 @@ test pack-20.1 {<> fires on last pack forget} -body { bind . <> {} destroy .1 } -result {1} -test pack-20.2 {<> fires on last packed child destruction} -body { +test pack-20.2 {<> fires on last packed child destruction} -setup { global A - catch {unset A} + unset -nocomplain A +} -body { pack [frame .1] update bind . <> {incr A} @@ -1652,9 +1633,10 @@ test pack-20.2 {<> fires on last packed child destruction} -body bind . <> {} destroy .1 } -result {1} -test pack-20.3 { does not fire on last pack forget} -body { +test pack-20.3 { does not fire on last pack forget} -setup { global A - catch {unset A} + unset -nocomplain A +} -body { pack [frame .1] update bind . {set A 1} @@ -1665,9 +1647,10 @@ test pack-20.3 { does not fire on last pack forget} -body { bind . {} destroy .1 } -result {0} -test pack-20.4 {<> does not fire on forelast pack forget} -body { +test pack-20.4 {<> does not fire on forelast pack forget} -setup { global A - catch {unset A} + unset -nocomplain A +} -body { pack [frame .1] pack [frame .2] update @@ -1679,9 +1662,10 @@ test pack-20.4 {<> does not fire on forelast pack forget} -body bind . <> {} destroy .1 .2 } -result {0} -test pack-20.5 { does not fire on last pack forget} -body { +test pack-20.5 { does not fire on last pack forget} -setup { global A - catch {unset A} + unset -nocomplain A +} -body { pack [frame .1] pack [frame .2] update @@ -1693,9 +1677,10 @@ test pack-20.5 { does not fire on last pack forget} -body { bind . {} destroy .1 .2 } -result {1} -test pack-20.6 {<> does not fire on last pack forget if propagation is off} -body { +test pack-20.6 {<> does not fire on last pack forget if propagation is off} -setup { global A - catch {unset A} + unset -nocomplain A +} -body { pack [frame .1] pack propagate . 0 update @@ -1707,11 +1692,11 @@ test pack-20.6 {<> does not fire on last pack forget if propagat bind . <> {} destroy .1 } -result {0} - - + # cleanup cleanupTests return - - +# Local Variables: +# mode: tcl +# End: -- cgit v0.12