summaryrefslogtreecommitdiffstats
path: root/tests/grid.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/grid.test')
-rw-r--r--tests/grid.test157
1 files changed, 97 insertions, 60 deletions
diff --git a/tests/grid.test b/tests/grid.test
index 128c244..8d2754f 100644
--- a/tests/grid.test
+++ b/tests/grid.test
@@ -1,19 +1,36 @@
-# This file is a Tcl script to test out the *NEW* "grid" command of Tk. It is
-# (almost) organized in the standard fashion for Tcl tests.
+# This file is a Tcl script to test out the *NEW* "grid" command of Tk.
#
# Copyright © 1996 Sun Microsystems, Inc.
# Copyright © 1998-1999 Scriptics Corporation.
# All rights reserved.
-package require tcltest 2.2
-eval tcltest::configure $argv
-tcltest::loadTestedCommands
-namespace import -force tcltest::test
+#
+# TESTFILE INITIALIZATION
+#
+
+package require tcltest 2.2; # needed in mode -singleproc 0
+
+# Load the main script main.tcl, which takes care of:
+# - setup for the application and the root window
+# - importing commands from the tcltest namespace
+# - loading of the testutils mechanism along with its utility procs
+# - loading of Tk specific test constraints (additionally to constraints
+# provided by the package tcltest)
+source [file join [tcltest::configure -testdir] main.tcl]
-# helper routine to return "." to a sane state after a test.
-# The variable GRID_VERBOSE can be used to "look" at the result of one or all
-# of the tests
+# Ensure a pristine initial window state
+resetWindows
+#
+# LOCAL UTILITY PROCS
+#
+
+# grid_reset --
+#
+# Helper routine to return "." to a sane state after a test.
+# The variable GRID_VERBOSE can be used to "look" at the result of one or all
+# of the tests
+#
proc grid_reset {{test ?} {top .}} {
global GRID_VERBOSE
if {[info exists GRID_VERBOSE]} {
@@ -37,9 +54,17 @@ proc grid_reset {{test ?} {top .}} {
update
}
+#
+# COMMON TEST SETUP
+#
+
grid_reset 0.0
wm geometry . {}
-
+
+#
+# TESTS
+#
+
test grid-1.1 {basic argument checking} -body {
grid
} -returnCodes error -result {wrong # args: should be "grid option arg ?arg ...?"}
@@ -247,7 +272,7 @@ test grid-4.4 {forget} -body {
grid .c -row 0 -column 0
grid info .c
} -cleanup {
- grid_reset 4.3.1
+ grid_reset 4.4
} -result {-in . -column 0 -row 0 -columnspan 1 -rowspan 1 -ipadx 0 -ipady 0 -padx 0 -pady 0 -sticky {}}
test grid-4.5 {forget, calling Tk_UnmaintainGeometry} -body {
frame .f -bd 2 -relief raised
@@ -261,7 +286,7 @@ test grid-4.5 {forget, calling Tk_UnmaintainGeometry} -body {
update
lappend x [winfo ismapped .f2]
} -cleanup {
- grid_reset 4.4
+ grid_reset 4.5
} -result {1 0}
test grid-5.1 {info: basic argument checking} -body {
@@ -793,17 +818,17 @@ test grid-10.32 {column/row configure} -body {
destroy .f
return $res
} -cleanup {
- grid_reset 10.35
+ grid_reset 10.32
} -result {}
test grid-10.33 {column/row configure} -body {
grid columnconfigure . all
} -cleanup {
- grid_reset 10.36
+ grid_reset 10.33
} -returnCodes error -result {expected integer but got "all" (when retrieving options only integer indices are allowed)}
test grid-10.34 {column/row configure} -body {
grid columnconfigure . 100000
} -cleanup {
- grid_reset 10.37
+ grid_reset 10.34
} -result {-minsize 0 -pad 0 -uniform {} -weight 0}
test grid-10.35 {column/row configure} -body {
# This is a test for bug 1423666 where a column >= 10000 caused
@@ -818,7 +843,10 @@ test grid-10.35 {column/row configure} -body {
lappend res [catch {grid .f -column 9998 -columnspan 2} msg] $msg ; update
lappend res [catch {grid .f -row 9998 -rowspan 2} msg] $msg ; update
return $res
-} -cleanup {destroy .f} -result [lrange {
+} -cleanup {
+ destroy .f
+ grid_reset 10.35
+} -result [lrange {
1 {column out of bounds}
1 {row out of bounds}
1 {column out of bounds}
@@ -826,7 +854,6 @@ test grid-10.35 {column/row configure} -body {
1 {column out of bounds}
1 {row out of bounds}
} 0 end]
-grid_reset 10.38
test grid-10.36 {column/row configure} -body {
# Additional tests for row/column overflow
frame .f
@@ -841,13 +868,15 @@ test grid-10.36 {column/row configure} -body {
lappend res [catch {eval grid [string repeat " x " 9999] .f} msg] $msg
update
return $res
-} -cleanup {destroy .f .g} -result [lrange {
+} -cleanup {
+ destroy .f .g
+ grid_reset 10.36
+} -result [lrange {
1 {row out of bounds}
1 {row out of bounds}
1 {column out of bounds}
1 {column out of bounds}
} 0 end]
-grid_reset 10.39
# auto-placement tests
test grid-11.1 {default widget placement} -body {
@@ -1146,33 +1175,33 @@ test grid-13.2 {-in} -body {
[catch {grid .f -in .f} err] $err \
[winfo manager .f]
} -cleanup {
- grid_reset 13.1.1
+ grid_reset 13.2
} -result {{} 1 {window can't be managed in itself} {}}
test grid-13.3 {-in} -body {
frame .f -bg red
grid .f -in .bad
} -cleanup {
- grid_reset 13.2
+ grid_reset 13.3
} -returnCodes error -result {bad window path name ".bad"}
test grid-13.4 {-in} -body {
frame .f -bg red
toplevel .top
grid .f -in .top
} -cleanup {
- grid_reset 13.3
+ grid_reset 13.4
+ destroy .top
} -returnCodes error -result {can't put ".f" inside ".top"}
-destroy .top
test grid-13.5 {-ipadx} -body {
frame .f -width 20 -height 20 -highlightthickness 0 -bg red
grid .f -ipadx x
} -cleanup {
- grid_reset 13.4
+ grid_reset 13.5
} -returnCodes error -result {bad ipadx value "x": must be positive screen distance}
test grid-13.6 {-ipadx} -body {
frame .f -width 20 -height 20 -highlightthickness 0 -bg red
grid .f -ipadx {5 5}
} -cleanup {
- grid_reset 13.4.1
+ grid_reset 13.6
} -returnCodes error -result {bad ipadx value "5 5": must be positive screen distance}
test grid-13.7 {-ipadx} -body {
frame .f -width 200 -height 100 -highlightthickness 0 -bg red
@@ -1183,19 +1212,19 @@ test grid-13.7 {-ipadx} -body {
update
list $a [winfo width .f]
} -cleanup {
- grid_reset 13.5
+ grid_reset 13.7
} -result {200 202}
test grid-13.8 {-ipady} -body {
frame .f -width 20 -height 20 -highlightthickness 0 -bg red
grid .f -ipady x
} -cleanup {
- grid_reset 13.6
+ grid_reset 13.8
} -returnCodes error -result {bad ipady value "x": must be positive screen distance}
test grid-13.9 {-ipady} -body {
frame .f -width 20 -height 20 -highlightthickness 0 -bg red
grid .f -ipady {5 5}
} -cleanup {
- grid_reset 13.6.1
+ grid_reset 13.9
} -returnCodes error -result {bad ipady value "5 5": must be positive screen distance}
test grid-13.10 {-ipady} -body {
frame .f -width 200 -height 100 -highlightthickness 0 -bg red
@@ -1206,19 +1235,19 @@ test grid-13.10 {-ipady} -body {
update
list $a [winfo height .f]
} -cleanup {
- grid_reset 13.7
+ grid_reset 13.10
} -result {100 102}
test grid-13.11 {-padx} -body {
frame .f -width 20 -height 20 -highlightthickness 0 -bg red
grid .f -padx x
} -cleanup {
- grid_reset 13.8
+ grid_reset 13.11
} -returnCodes error -result {bad pad value "x": must be positive screen distance}
test grid-13.12 {-padx} -body {
frame .f -width 20 -height 20 -highlightthickness 0 -bg red
grid .f -padx {10 x}
} -cleanup {
- grid_reset 13.8.1
+ grid_reset 13.12
} -returnCodes error -result {bad 2nd pad value "x": must be positive screen distance}
test grid-13.13 {-padx} -body {
frame .f -width 200 -height 100 -highlightthickness 0 -bg red
@@ -1229,7 +1258,7 @@ test grid-13.13 {-padx} -body {
update
list $a "[winfo width .f] [winfo width .] [winfo x .f]"
} -cleanup {
- grid_reset 13.9
+ grid_reset 13.13
} -result {{200 200} {200 202 1}}
test grid-13.14 {-padx} -body {
frame .f -width 200 -height 100 -highlightthickness 0 -bg red
@@ -1240,19 +1269,19 @@ test grid-13.14 {-padx} -body {
update
list $a "[winfo width .f] [winfo width .] [winfo x .f]"
} -cleanup {
- grid_reset 13.9.1
+ grid_reset 13.14
} -result {{200 200} {200 215 10}}
test grid-13.15 {-pady} -body {
frame .f -width 20 -height 20 -highlightthickness 0 -bg red
grid .f -pady x
} -cleanup {
- grid_reset 13.10
+ grid_reset 13.15
} -returnCodes error -result {bad pad value "x": must be positive screen distance}
test grid-13.16 {-pady} -body {
frame .f -width 20 -height 20 -highlightthickness 0 -bg red
grid .f -pady {10 x}
} -cleanup {
- grid_reset 13.10.1
+ grid_reset 13.16
} -returnCodes error -result {bad 2nd pad value "x": must be positive screen distance}
test grid-13.17 {-pady} -body {
frame .f -width 200 -height 100 -highlightthickness 0 -bg red
@@ -1263,7 +1292,7 @@ test grid-13.17 {-pady} -body {
update
list $a "[winfo height .f] [winfo height .] [winfo y .f]"
} -cleanup {
- grid_reset 13.11
+ grid_reset 13.17
} -result {{100 100} {100 102 1}}
test grid-13.18 {-pady} -body {
frame .f -width 200 -height 100 -highlightthickness 0 -bg red
@@ -1274,7 +1303,7 @@ test grid-13.18 {-pady} -body {
update
list $a "[winfo height .f] [winfo height .] [winfo y .f]"
} -cleanup {
- grid_reset 13.11.1
+ grid_reset 13.18
} -result {{100 100} {100 120 4}}
test grid-13.19 {-ipad x and y} -body {
frame .f -width 20 -height 20 -highlightthickness 0 -bg red
@@ -1293,7 +1322,7 @@ test grid-13.19 {-ipad x and y} -body {
}
return $a
} -cleanup {
- grid_reset 13.12
+ grid_reset 13.19
} -result { 0,0:,65,40,20,20 0,5:,65,35,20,30 5,0:,60,40,30,20 5,5:,60,35,30,30}
test grid-13.20 {reparenting} -body {
frame .1
@@ -1310,7 +1339,7 @@ test grid-13.20 {reparenting} -body {
unset info
return $a
} -cleanup {
- grid_reset 13.13
+ grid_reset 13.20
} -result {.b,,.1 ,.b,.2}
test grid-14.1 {structure notify} -body {
@@ -1969,33 +1998,36 @@ test grid-21.7 {anchor} -body {
test grid-22.1 {remove: basic argument checking} {
list [catch {grid remove foo} msg] $msg
} {1 {bad window path name "foo"}}
-test grid-22.2 {remove} {
+test grid-22.2 {remove} -body {
button .c
grid [button .b]
set a [grid content .]
grid remove .b .c
lappend a [grid content .]
return $a
-} {.b {}}
-grid_reset 22.2
-test grid-22.3 {remove} {
+} -cleanup {
+ grid_reset 22.2
+} -result {.b {}}
+test grid-22.3 {remove} -body {
button .c
grid .c -row 2 -column 2 -rowspan 2 -columnspan 2 -padx 3 -pady 4 -sticky ns
grid remove .c
grid .c -row 0 -column 0
grid info .c
-} {-in . -column 0 -row 0 -columnspan 2 -rowspan 2 -ipadx 0 -ipady 0 -padx 3 -pady 4 -sticky ns}
-grid_reset 22.3
-test grid-22.3.1 {remove} {
+} -cleanup {
+ grid_reset 22.3
+} -result {-in . -column 0 -row 0 -columnspan 2 -rowspan 2 -ipadx 0 -ipady 0 -padx 3 -pady 4 -sticky ns}
+test grid-22.3.1 {remove} -body {
frame .a
button .c
grid .c -in .a -row 2 -column 2 -rowspan 2 -columnspan 2 -padx {3 5} -pady {4 7} -sticky ns
grid remove .c
grid .c -row 0 -column 0
grid info .c
-} {-in .a -column 0 -row 0 -columnspan 2 -rowspan 2 -ipadx 0 -ipady 0 -padx {3 5} -pady {4 7} -sticky ns}
-grid_reset 22.3.1
-test grid-22.4 {remove, calling Tk_UnmaintainGeometry} {
+} -cleanup {
+ grid_reset 22.3.1
+} -result {-in .a -column 0 -row 0 -columnspan 2 -rowspan 2 -ipadx 0 -ipady 0 -padx {3 5} -pady {4 7} -sticky ns}
+test grid-22.4 {remove, calling Tk_UnmaintainGeometry} -body {
frame .f -bd 2 -relief raised
place .f -x 10 -y 20 -width 200 -height 100
frame .f2 -width 50 -height 30 -bg red
@@ -2006,9 +2038,10 @@ test grid-22.4 {remove, calling Tk_UnmaintainGeometry} {
place .f -x 30
update
lappend x [winfo ismapped .f2]
-} {1 0}
-grid_reset 22.4
-test grid-22.5 {remove} {
+} -cleanup {
+ grid_reset 22.4
+} -result {1 0}
+test grid-22.5 {remove} -body {
frame .a
button .c
grid .c -in .a -row 2 -column 2 -rowspan 2 -columnspan 2 -padx {3 5} -pady {4 7} -sticky ns
@@ -2018,11 +2051,12 @@ test grid-22.5 {remove} {
destroy .a
grid .c -row 0 -column 0
grid info .c
-} {-in . -column 0 -row 0 -columnspan 2 -rowspan 2 -ipadx 0 -ipady 0 -padx {3 5} -pady {4 7} -sticky ns}
-grid_reset 22.5
+} -cleanup {
+ grid_reset 22.5
+} -result {-in . -column 0 -row 0 -columnspan 2 -rowspan 2 -ipadx 0 -ipady 0 -padx {3 5} -pady {4 7} -sticky ns}
test grid-23 {grid configure -in leaked from previous container window - bug
- 6aea69fccbb266b7f0437686379fbe5b55442958} {
+ 6aea69fccbb266b7f0437686379fbe5b55442958} -body {
frame .f
frame .g
pack .f .g
@@ -2037,8 +2071,9 @@ test grid-23 {grid configure -in leaked from previous container window - bug
pack forget .f
update
winfo ismapped .t ; # must return 1
-} 1
-grid_reset 23
+} -cleanup {
+ grid_reset 23
+} -result 1
test grid-24.1 {<<NoManagedChild>> fires on last grid forget} -setup {
global A
@@ -2154,10 +2189,12 @@ test grid-24.8 {<<NoManagedChild>> does not fire on last grid forget if propagat
bind . <<NoManagedChild>> {}
grid_reset 24.8
} -result 0
-
-# cleanup
+
+#
+# TESTFILE CLEANUP
+#
+
cleanupTests
-return
# Local Variables:
# mode: tcl
generated by cgit v0.12 at 2026-03-26 10:25:35 (GMT)