summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--PC/_winreg.c18
1 files changed, 11 insertions, 7 deletions
diff --git a/PC/_winreg.c b/PC/_winreg.c
index 84bf3c4..edfadac 100644
--- a/PC/_winreg.c
+++ b/PC/_winreg.c
@@ -830,19 +830,23 @@ Py2Reg(PyObject *value, DWORD typ, BYTE **retDataBuf, DWORD *retDataSize)
if (value == Py_None)
*retDataSize = 0;
else {
- if (!PyString_Check(value))
- return 0;
- *retDataSize = PyString_Size(value);
+ void *src_buf;
+ PyBufferProcs *pb = value->ob_type->tp_as_buffer;
+ if (pb==NULL) {
+ PyErr_Format(PyExc_TypeError,
+ "Objects of type '%s' can not "
+ "be used as binary registry values",
+ value->ob_type->tp_name);
+ return FALSE;
+ }
+ *retDataSize = (*pb->bf_getreadbuffer)(value, 0, &src_buf);
*retDataBuf = (BYTE *)PyMem_NEW(char,
*retDataSize);
if (*retDataBuf==NULL){
PyErr_NoMemory();
return FALSE;
}
- memcpy(*retDataBuf,
- PyString_AS_STRING(
- (PyStringObject *)value),
- *retDataSize);
+ memcpy(*retDataBuf, src_buf, *retDataSize);
}
break;
}
608074 Tk is a free and open-source, cross-platform widget toolkit that provides a library of basic elements of GUI widgets for building a graphical user interface (GUI) in many programming languages.
summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorfvogel <fvogelnew1@free.fr>2022-12-05 19:25:02 (GMT)
committerfvogel <fvogelnew1@free.fr>2022-12-05 19:25:02 (GMT)
commit3344b9e2f1e077803328c5b2179510c6a2b1aab2 (patch)
tree74f24a669df5fe77e5187d5092fa527dd3dd3ff9 /tests
parent7ff8ee62b5f641e9bf553875cb5966081108bad7 (diff)
parent021549410c776f2de43c46264a75876d5d88de53 (diff)
downloadtk-3344b9e2f1e077803328c5b2179510c6a2b1aab2.zip
tk-3344b9e2f1e077803328c5b2179510c6a2b1aab2.tar.gz
tk-3344b9e2f1e077803328c5b2179510c6a2b1aab2.tar.bz2
Merge branch less_tests_constraints.
Diffstat (limited to 'tests')
-rw-r--r--tests/bind.test35
-rw-r--r--tests/border.test1
-rw-r--r--tests/busy.test8
-rw-r--r--tests/button.test80
-rw-r--r--tests/canvPs.test4
-rw-r--r--tests/canvText.test16
-rw-r--r--tests/canvas.test24
-rw-r--r--tests/color.test2
-rw-r--r--tests/constraints.tcl6
-rw-r--r--tests/dialog.test6
-rw-r--r--tests/entry.test2
-rw-r--r--tests/font.test60
-rw-r--r--tests/fontchooser.test8
-rw-r--r--tests/frame.test436
-rw-r--r--tests/geometry.test2
-rw-r--r--tests/grid.test15
-rw-r--r--tests/image.test2
-rw-r--r--tests/imgBmap.test2
-rw-r--r--tests/imgPNG.test1
-rw-r--r--tests/imgPhoto.test8
-rw-r--r--tests/listbox.test2
-rw-r--r--tests/message.test14
-rw-r--r--tests/pack.test22
-rw-r--r--tests/panedwindow.test4
-rw-r--r--tests/place.test33
-rw-r--r--tests/safePrimarySelection.test32
-rw-r--r--tests/scale.test62
-rw-r--r--tests/scrollbar.test12
-rw-r--r--tests/send.test4
-rw-r--r--tests/spinbox.test8
-rw-r--r--tests/text.test267
-rw-r--r--tests/textDisp.test81
-rw-r--r--tests/textIndex.test2
-rw-r--r--tests/textMark.test4
-rw-r--r--tests/textTag.test14
-rw-r--r--tests/textWind.test4
-rw-r--r--tests/tk.test12
-rw-r--r--tests/ttk/combobox.test12
-rw-r--r--tests/ttk/entry.test10
-rw-r--r--tests/ttk/labelframe.test4
-rw-r--r--tests/ttk/notebook.test4
-rw-r--r--tests/ttk/panedwindow.test4
-rw-r--r--tests/ttk/radiobutton.test2
-rw-r--r--tests/ttk/scrollbar.test2
-rw-r--r--tests/ttk/treetags.test11
-rw-r--r--tests/ttk/treeview.test54
-rw-r--r--tests/ttk/ttk.test12
-rw-r--r--tests/ttk/validate.test2
-rw-r--r--tests/unixEmbed.test4
-rw-r--r--tests/unixFont.test10
-rw-r--r--tests/unixSelect.test4
-rw-r--r--tests/unixWm.test20
-rw-r--r--tests/util.test8
-rw-r--r--tests/visual.test8
-rwxr-xr-xtests/winDialog.test22
-rw-r--r--tests/winFont.test12
-rw-r--r--tests/winSend.test10
-rw-r--r--tests/winWm.test4
-rw-r--r--tests/winfo.test22
-rw-r--r--tests/wm.test15
60 files changed, 760 insertions, 791 deletions
diff --git a/tests/bind.test b/tests/bind.test
index 7b7fb62..73d2a09 100644
--- a/tests/bind.test
+++ b/tests/bind.test
@@ -36,22 +36,12 @@ proc unsetBindings {} {
# move the mouse pointer away of the testing area
# otherwise some spurious events may pollute the tests
-# also, this will procure a known grab state at startup
-# for tests mixing grabs and pointer warps
-proc pointerAway {} {
- toplevel .top
- wm geometry .top 50x50-50-50
- update
- # On KDE/Plasma _with_the_Aurorae_theme_ (at least), setting up the toplevel
- # will not be finished right after the above 'update'. The WM still
- # needs some time before the window is fully ready. For me 50 ms is enough,
- # but let's wait more (it depends on computer performance).
- after 100 ; update
- event generate .top <Button-1> -warp 1
- controlPointerWarpTiming
- destroy .top
-}
-pointerAway
+toplevel .top
+wm geometry .top 50x50-50-50
+update
+event generate .top <Button-1> -warp 1
+controlPointerWarpTiming
+destroy .top
test bind-1.1 {bind command} -body {
bind
@@ -3093,7 +3083,7 @@ test bind-22.32 {HandleEventGenerate: options <Expose> -count 20} -setup {
return $x
} -cleanup {
destroy .t.f
-} -result {20}
+} -result 20
test bind-22.33 {HandleEventGenerate: options <Key> -count 20} -setup {
frame .t.f -class Test -width 150 -height 100
@@ -6950,7 +6940,8 @@ test bind-35.3 {Events agree for modifier keys} -constraints {aqua} -setup {
} -result pass
test bind-36.1 {pointer warp with grab on toplevel, bug [e3888d5820]} -setup {
- pointerAway
+ event generate {} <Motion> -warp 1 -x 50 -y 50
+ controlPointerWarpTiming
toplevel .top
grab release .top
wm geometry .top 200x200+300+300
@@ -6964,17 +6955,13 @@ test bind-36.1 {pointer warp with grab on toplevel, bug [e3888d5820]} -setup {
# but let's wait more (it depends on computer performance).
after 100 ; update
} -body {
- grab .top ; # this will queue events
- after 50
- update
+ grab .top
event generate .top.l <Motion> -warp 1 -x 10 -y 10
controlPointerWarpTiming
foreach {x1 y1} [winfo pointerxy .top.l] {}
event generate {} <Motion> -warp 1 -x 50 -y 50
controlPointerWarpTiming
- grab release .top ; # this will queue events
- after 50
- update
+ grab release .top
event generate .top.l <Motion> -warp 1 -x 10 -y 10
controlPointerWarpTiming
foreach {x2 y2} [winfo pointerxy .top.l] {}
diff --git a/tests/border.test b/tests/border.test
index e13d52a..d6ff5c7 100644
--- a/tests/border.test
+++ b/tests/border.test
@@ -127,6 +127,7 @@ test border-2.2 {Tk_Free3DBorder - unlinking from list} -constraints {
destroy .b .t2 .t3 .t
} -result {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}}
+
test border-3.1 {FreeBorderObjProc} -constraints {
testborder
} -setup {
diff --git a/tests/busy.test b/tests/busy.test
index 98d83a8..ae7a2a5 100644
--- a/tests/busy.test
+++ b/tests/busy.test
@@ -342,14 +342,14 @@ test busy-6.1 {tk busy status} -returnCodes error -body {
} -result {wrong # args: should be "tk busy status window"}
test busy-6.2 {tk busy status non existing window} -body {
tk busy status .f
-} -result {0}
+} -result 0
test busy-6.3 {tk busy status non busy window} -setup {
pack [frame .f]
} -body {
tk busy status .f
} -cleanup {
destroy .f
-} -result {0}
+} -result 0
test busy-6.4 {tk busy status busy window} -setup {
pack [frame .f]
tk busy hold .f
@@ -359,7 +359,7 @@ test busy-6.4 {tk busy status busy window} -setup {
} -cleanup {
tk busy forget .f
destroy .f
-} -result {1}
+} -result 1
test busy-6.5 {tk busy status forgotten busy window} -setup {
pack [frame .f]
tk busy hold .f
@@ -369,7 +369,7 @@ test busy-6.5 {tk busy status forgotten busy window} -setup {
tk busy status .f
} -cleanup {
destroy .f
-} -result {0}
+} -result 0
test busy-7.1 {tk busy current no busy} -body {
tk busy current
diff --git a/tests/button.test b/tests/button.test
index f3292b31..9a69b1b 100644
--- a/tests/button.test
+++ b/tests/button.test
@@ -334,7 +334,7 @@ test button-1.33 {configuration option: "bd" for label} -setup {
.l cget -bd
} -cleanup {
destroy .l
-} -result {4}
+} -result 4
test button-1.34 {configuration option: "bd" for label} -setup {
label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .l
@@ -353,7 +353,7 @@ test button-1.35 {configuration option: "bd" for button} -setup {
.b cget -bd
} -cleanup {
destroy .b
-} -result {4}
+} -result 4
test button-1.36 {configuration option: "bd" for button} -setup {
button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .b
@@ -372,7 +372,7 @@ test button-1.37 {configuration option: "bd" for checkbutton} -setup {
.c cget -bd
} -cleanup {
destroy .c
-} -result {4}
+} -result 4
test button-1.38 {configuration option: "bd" for checkbutton} -setup {
checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .c
@@ -391,7 +391,7 @@ test button-1.39 {configuration option: "bd" for radiobutton} -setup {
.r cget -bd
} -cleanup {
destroy .r
-} -result {4}
+} -result 4
test button-1.40 {configuration option: "bd" for radiobutton} -setup {
radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .r
@@ -1165,7 +1165,7 @@ test button-1.119 {configuration option: "height" for label} -setup {
.l cget -height
} -cleanup {
destroy .l
-} -result {18}
+} -result 18
test button-1.120 {configuration option: "height" for label} -setup {
label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .l
@@ -1184,7 +1184,7 @@ test button-1.121 {configuration option: "height" for button} -setup {
.b cget -height
} -cleanup {
destroy .b
-} -result {18}
+} -result 18
test button-1.122 {configuration option: "height" for button} -setup {
button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .b
@@ -1203,7 +1203,7 @@ test button-1.123 {configuration option: "height" for checkbutton} -setup {
.c cget -height
} -cleanup {
destroy .c
-} -result {18}
+} -result 18
test button-1.124 {configuration option: "height" for checkbutton} -setup {
checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .c
@@ -1222,7 +1222,7 @@ test button-1.125 {configuration option: "height" for radiobutton} -setup {
.r cget -height
} -cleanup {
destroy .r
-} -result {18}
+} -result 18
test button-1.126 {configuration option: "height" for radiobutton} -setup {
radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .r
@@ -1566,7 +1566,7 @@ test button-1.159 {configuration option: "indicatoron" for checkbutton} -setup {
.c cget -indicatoron
} -cleanup {
destroy .c
-} -result {1}
+} -result 1
test button-1.160 {configuration option: "indicatoron" for checkbutton} -setup {
checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .c
@@ -1585,7 +1585,7 @@ test button-1.161 {configuration option: "indicatoron" for radiobutton} -setup {
.r cget -indicatoron
} -cleanup {
destroy .r
-} -result {1}
+} -result 1
test button-1.162 {configuration option: "indicatoron" for radiobutton} -setup {
radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .r
@@ -1955,7 +1955,7 @@ test button-1.199 {configuration option: "repeatdelay" for button} -setup {
.b cget -repeatdelay
} -cleanup {
destroy .b
-} -result {100}
+} -result 100
test button-1.200 {configuration option: "repeatdelay" for button} -setup {
button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .b
@@ -1975,7 +1975,7 @@ test button-1.201 {configuration option: "repeatinterval" for button} -setup {
.b cget -repeatinterval
} -cleanup {
destroy .b
-} -result {100}
+} -result 100
test button-1.202 {configuration option: "repeatinterval" for button} -setup {
button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .b
@@ -2405,7 +2405,7 @@ test button-1.243 {configuration option: "underline" for label} -setup {
.l cget -underline
} -cleanup {
destroy .l
-} -result {5}
+} -result 5
test button-1.244 {configuration option: "underline" for label} -setup {
label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .l
@@ -2424,7 +2424,7 @@ test button-1.245 {configuration option: "underline" for button} -setup {
.b cget -underline
} -cleanup {
destroy .b
-} -result {5}
+} -result 5
test button-1.246 {configuration option: "underline" for button} -setup {
button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .b
@@ -2443,7 +2443,7 @@ test button-1.247 {configuration option: "underline" for checkbutton} -setup {
.c cget -underline
} -cleanup {
destroy .c
-} -result {5}
+} -result 5
test button-1.248 {configuration option: "underline" for checkbutton} -setup {
checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .c
@@ -2462,7 +2462,7 @@ test button-1.249 {configuration option: "underline" for radiobutton} -setup {
.r cget -underline
} -cleanup {
destroy .r
-} -result {5}
+} -result 5
test button-1.250 {configuration option: "underline" for radiobutton} -setup {
radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .r
@@ -2514,7 +2514,7 @@ test button-1.254 {configuration option: "width" for label} -setup {
.l cget -width
} -cleanup {
destroy .l
-} -result {402}
+} -result 402
test button-1.255 {configuration option: "width" for label} -setup {
label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .l
@@ -2533,7 +2533,7 @@ test button-1.256 {configuration option: "width" for button} -setup {
.b cget -width
} -cleanup {
destroy .b
-} -result {402}
+} -result 402
test button-1.257 {configuration option: "width" for button} -setup {
button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .b
@@ -2552,7 +2552,7 @@ test button-1.258 {configuration option: "width" for checkbutton} -setup {
.c cget -width
} -cleanup {
destroy .c
-} -result {402}
+} -result 402
test button-1.259 {configuration option: "width" for checkbutton} -setup {
checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .c
@@ -2571,7 +2571,7 @@ test button-1.260 {configuration option: "width" for radiobutton} -setup {
.r cget -width
} -cleanup {
destroy .r
-} -result {402}
+} -result 402
test button-1.261 {configuration option: "width" for radiobutton} -setup {
radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .r
@@ -2591,7 +2591,7 @@ test button-1.262 {configuration option: "wraplength" for label} -setup {
.l cget -wraplength
} -cleanup {
destroy .l
-} -result {100}
+} -result 100
test button-1.263 {configuration option: "wraplength" for label} -setup {
label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .l
@@ -2610,7 +2610,7 @@ test button-1.264 {configuration option: "wraplength" for button} -setup {
.b cget -wraplength
} -cleanup {
destroy .b
-} -result {100}
+} -result 100
test button-1.265 {configuration option: "wraplength" for button} -setup {
button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .b
@@ -2629,7 +2629,7 @@ test button-1.266 {configuration option: "wraplength" for checkbutton} -setup {
.c cget -wraplength
} -cleanup {
destroy .c
-} -result {100}
+} -result 100
test button-1.267 {configuration option: "wraplength" for checkbutton} -setup {
checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .c
@@ -2648,7 +2648,7 @@ test button-1.268 {configuration option: "wraplength" for radiobutton} -setup {
.r cget -wraplength
} -cleanup {
destroy .r
-} -result {100}
+} -result 100
test button-1.269 {configuration option: "wraplength" for radiobutton} -setup {
radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
pack .r
@@ -2834,13 +2834,13 @@ test button-3.13 {ButtonWidgetCmd procedure, "configure" option} -body {
lindex [.b configure -highlightthickness] 4
} -cleanup {
destroy .b
-} -result {3}
+} -result 3
test button-3.14 {ButtonWidgetCmd procedure, "configure" option} -body {
checkbutton .c
llength [.c configure]
} -cleanup {
destroy .c
-} -result {41}
+} -result 41
test button-3.15 {ButtonWidgetCmd procedure, "configure" option} -body {
button .b
.b configure -gorp
@@ -2889,7 +2889,7 @@ test button-3.21 {ButtonWidgetCmd procedure, "deselect" option} -body {
return $checkvar
} -cleanup {
destroy .c
-} -result {0}
+} -result 0
test button-3.22 {ButtonWidgetCmd procedure, "deselect" option} -body {
radiobutton .r -variable radiovar -value red
set radiovar green
@@ -3249,7 +3249,7 @@ test button-5.4 {ConfigureButton - variable trace} -body { ;# ex 6.2a
return $y
} -cleanup {
destroy .c
-} -result {1}
+} -result 1
test button-5.5 {ConfigureButton - image handling} -constraints {
testImageType
@@ -3282,7 +3282,7 @@ test button-5.7 {ConfigureButton - setting selected state from variable} -body {
return $y
} -cleanup {
destroy .c
-} -result {0}
+} -result 0
test button-5.8 {ConfigureButton - setting selected state from variable} -setup {
unset -nocomplain x
} -body {
@@ -3487,7 +3487,7 @@ test button-5.25 {ConfigureButton - computing geometry} -setup {
expr {$old == $new}
} -cleanup {
destroy .b
-} -result {0}
+} -result 0
test button-6.1 {ButtonEventProc procedure} -body {
button .b -text "Test Button" -command {
@@ -3554,7 +3554,7 @@ test button-8.3 {TkInvokeButton procedure} -setup {
} -cleanup {
destroy .c
trace vdelete x w bogusTrace
-} -result {1}
+} -result 1
test button-8.4 {TkInvokeButton procedure} -setup {
set x 1
} -body {
@@ -3575,7 +3575,7 @@ test button-8.5 {TkInvokeButton procedure} -setup {
} -cleanup {
destroy .c
trace vdelete x w bogusTrace
-} -result {0}
+} -result 0
test button-8.6 {TkInvokeButton procedure} -setup {
set x 0
@@ -3665,7 +3665,7 @@ test button-9.2 {ButtonVarProc procedure} -body {
return $x
} -cleanup {
destroy .c
-} -result {1}
+} -result 1
test button-9.3 {ButtonVarProc procedure} -setup {
set x 1
} -body {
@@ -3675,7 +3675,7 @@ test button-9.3 {ButtonVarProc procedure} -setup {
return $x
} -cleanup {
destroy .c
-} -result {1}
+} -result 1
test button-9.4 {ButtonVarProc procedure} -setup {
set x 0
} -body {
@@ -3685,7 +3685,7 @@ test button-9.4 {ButtonVarProc procedure} -setup {
return $x
} -cleanup {
destroy .c
-} -result {0}
+} -result 0
test button-9.5 {ButtonVarProc procedure} -setup {
set x 1
} -body {
@@ -3695,7 +3695,7 @@ test button-9.5 {ButtonVarProc procedure} -setup {
return $x
} -cleanup {
destroy .c
-} -result {0}
+} -result 0
test button-9.6 {ButtonVarProc procedure} -setup {
set x 0
} -body {
@@ -3705,7 +3705,7 @@ test button-9.6 {ButtonVarProc procedure} -setup {
return $x
} -cleanup {
destroy .c
-} -result {1}
+} -result 1
test button-9.7 {ButtonVarProc procedure} -setup {
set x 1
} -body {
@@ -3715,7 +3715,7 @@ test button-9.7 {ButtonVarProc procedure} -setup {
return $x
} -cleanup {
destroy .c
-} -result {1}
+} -result 1
test button-9.8 {ButtonVarProc procedure, can't read variable} -setup {
# This test does nothing but produce a core dump if there's a prbblem.
unset -nocomplain a
@@ -3751,7 +3751,7 @@ test button-10.2 {ButtonTextVarProc procedure} -setup {
expr {$old == $new}
} -cleanup {
destroy .b
-} -result {0}
+} -result 0
test button-11.1 {ButtonImageProc procedure} -constraints {
testImageType
@@ -3780,7 +3780,7 @@ test button-12.1 {button widget vs hidden commands} -body {
expr {$res1 == $res2}
} -cleanup {
destroy .b
-} -result {1}
+} -result 1
test button-13.1 {size behavior: label} -setup {
label .a -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
diff --git a/tests/canvPs.test b/tests/canvPs.test
index 126abe2..365eb1d 100644
--- a/tests/canvPs.test
+++ b/tests/canvPs.test
@@ -156,7 +156,7 @@ test canvPs-3.1 {test ps generation with an embedded window} -setup {
destroy .c
imageCleanup
removeFile bar.ps
-} -result {1}
+} -result 1
test canvPs-3.2 {test ps generation with an embedded window not mapped} -setup {
set bar [makeFile {} bar.ps]
file delete $bar
@@ -170,7 +170,7 @@ test canvPs-3.2 {test ps generation with an embedded window not mapped} -setup {
} -cleanup {
destroy .c
removeFile bar.ps
-} -result {1}
+} -result 1
test canvPs-4.1 {test ps generation with single-point uncolored poly, bug 734498} -body {
diff --git a/tests/canvText.test b/tests/canvText.test
index 2bafac3..10e4fb5 100644
--- a/tests/canvText.test
+++ b/tests/canvText.test
@@ -250,7 +250,7 @@ test canvText-4.6 {ConfigureText procedure: adjust cursor} -setup {
.c index test insert
} -cleanup {
.c delete test
-} -result {4}
+} -result 4
test canvText-5.1 {ConfigureText procedure: adjust cursor} -body {
@@ -573,7 +573,7 @@ test canvText-8.8 {TextInsert procedure: inserting before cursor} -setup {
.c icursor test 3
.c insert test 2 "xyz"
.c index test insert
-} -result {6}
+} -result 6
test canvText-8.9 {TextInsert procedure: inserting after cursor} -setup {
.c create text 20 20 -tag test
focus .c
@@ -583,7 +583,7 @@ test canvText-8.9 {TextInsert procedure: inserting after cursor} -setup {
.c icursor test 3
.c insert test 4 "xyz"
.c index test insert
-} -result {3}
+} -result 3
# Item used in 9.* tests
.c create text 20 20 -tag test
@@ -673,19 +673,19 @@ test canvText-9.13 {TextInsert procedure: move cursor} -body {
.c icursor test 6
.c dchars test 2 4
.c index test insert
-} -result {3}
+} -result 3
test canvText-9.14 {TextInsert procedure: keep cursor >= first} -body {
.c itemconfig test -text "abcdefghijk"
.c icursor test 6
.c dchars test 2 10
.c index test insert
-} -result {2}
+} -result 2
test canvText-9.15 {TextInsert procedure: cursor doesn't move} -body {
.c itemconfig test -text "abcdefghijk"
.c icursor test 5
.c dchars test 7 9
.c index test insert
-} -result {5}
+} -result 5
.c delete test
@@ -695,7 +695,7 @@ test canvText-10.1 {TextToPoint procedure} -body {
.c index test @0,0
} -cleanup {
.c delete test
-} -result {0}
+} -result 0
test canvText-11.1 {TextToArea procedure} -setup {
@@ -834,7 +834,7 @@ test canvText-15.1 {SetTextCursor procedure} -setup {
.c index test insert
} -cleanup {
.c delete test
-} -result {3}
+} -result 3
test canvText-16.1 {GetSelText procedure} -setup {
.c create text 0 0 -tag test
diff --git a/tests/canvas.test b/tests/canvas.test
index 4e391c8..f46996f 100644
--- a/tests/canvas.test
+++ b/tests/canvas.test
@@ -37,14 +37,14 @@ test canvas-1.4 {configuration options: bad value for "bg"} -body {
test canvas-1.5 {configuration options: good value for "bd"} -body {
.c configure -bd 4
.c cget -bd
-} -result {4}
+} -result 4
test canvas-1.6 {configuration options: bad value for "bd"} -body {
.c configure -bd badValue
} -returnCodes error -result {bad screen distance "badValue"}
test canvas-1.7 {configuration options: good value for "borderwidth"} -body {
.c configure -borderwidth 1.3
.c cget -borderwidth
-} -result {1}
+} -result 1
test canvas-1.8 {configuration options: bad value for "borderwidth"} -body {
.c configure -borderwidth badValue
} -returnCodes error -result {bad screen distance "badValue"}
@@ -58,7 +58,7 @@ test canvas-1.10 {configuration options: bad value for "closeenough"} -body {
test canvas-1.11 {configuration options: good value for "confine"} -body {
.c configure -confine true
.c cget -confine
-} -result {1}
+} -result 1
test canvas-1.12 {configuration options: bad value for "confine"} -body {
.c configure -confine silly
} -returnCodes error -result {expected boolean value but got "silly"}
@@ -72,7 +72,7 @@ test canvas-1.14 {configuration options: bad value for "cursor"} -body {
test canvas-1.15 {configuration options: good value for "height"} -body {
.c configure -height 2.1
.c cget -height
-} -result {2}
+} -result 2
test canvas-1.16 {configuration options: bad value for "height"} -body {
.c configure -height x42
} -returnCodes error -result {bad screen distance "x42"}
@@ -93,7 +93,7 @@ test canvas-1.20 {configuration options: bad value for "highlightcolor"} -body {
test canvas-1.21 {configuration options: good value for "highlightthickness"} -body {
.c configure -highlightthickness 18
.c cget -highlightthickness
-} -result {18}
+} -result 18
test canvas-1.22 {configuration options: bad value for "highlightthickness"} -body {
.c configure -highlightthickness badValue
} -returnCodes error -result {bad screen distance "badValue"}
@@ -107,28 +107,28 @@ test canvas-1.24 {configuration options: bad value for "insertbackground"} -body
test canvas-1.25 {configuration options: good value for "insertborderwidth"} -body {
.c configure -insertborderwidth 1.3
.c cget -insertborderwidth
-} -result {1}
+} -result 1
test canvas-1.26 {configuration options: bad value for "insertborderwidth"} -body {
.c configure -insertborderwidth 2.6x
} -returnCodes error -result {bad screen distance "2.6x"}
test canvas-1.27 {configuration options: good value for "insertofftime"} -body {
.c configure -insertofftime 100
.c cget -insertofftime
-} -result {100}
+} -result 100
test canvas-1.28 {configuration options: bad value for "insertofftime"} -body {
.c configure -insertofftime 3.2
} -returnCodes error -result {expected integer but got "3.2"}
test canvas-1.29 {configuration options: good value for "insertontime"} -body {
.c configure -insertontime 100
.c cget -insertontime
-} -result {100}
+} -result 100
test canvas-1.30 {configuration options: bad value for "insertontime"} -body {
.c configure -insertontime 3.2
} -returnCodes error -result {expected integer but got "3.2"}
test canvas-1.31 {configuration options: good value for "insertwidth"} -body {
.c configure -insertwidth 1.3
.c cget -insertwidth
-} -result {1}
+} -result 1
test canvas-1.32 {configuration options: bad value for "insertwidth"} -body {
.c configure -insertwidth 6x
} -returnCodes error -result {bad screen distance "6x"}
@@ -149,7 +149,7 @@ test canvas-1.36 {configuration options: bad value for "selectbackground"} -body
test canvas-1.37 {configuration options: good value for "selectborderwidth"} -body {
.c configure -selectborderwidth 1.3
.c cget -selectborderwidth
-} -result {1}
+} -result 1
test canvas-1.38 {configuration options: bad value for "selectborderwidth"} -body {
.c configure -selectborderwidth badValue
} -returnCodes error -result {bad screen distance "badValue"}
@@ -167,7 +167,7 @@ test canvas-1.41 {configuration options: good value for "takefocus"} -body {
test canvas-1.42 {configuration options: good value for "width"} -body {
.c configure -width 402
.c cget -width
-} -result {402}
+} -result 402
test canvas-1.43 {configuration options: bad value for "width"} -body {
.c configure -width xyz
} -returnCodes error -result {bad screen distance "xyz"}
@@ -727,7 +727,7 @@ test canvas-15.19 "basic coords check: centimeters are larger than pixels" -setu
} -body {
set id [.c create rect 0 0 1cm 1cm]
expr {[lindex [.c coords $id] 2]>1}
-} -result {1}
+} -result 1
test canvas-15.20 {bug [237971ce]} -setup {
destroy .c
canvas .c
diff --git a/tests/color.test b/tests/color.test
index 1e99a7d..5b8c5d2 100644
--- a/tests/color.test
+++ b/tests/color.test
@@ -163,7 +163,7 @@ test color-1.5 {Color table} nonPortable {
set fd [open ../xlib/rgb.txt]
set result {}
while {[gets $fd line] >= 0} {
- if {[string index $line 0] == "!"} continue
+ if {[string index $line 0] == "!"} continue
set rgb [c255 [winfo rgb . [lrange $line 3 end]]]
if {$rgb != [lrange $line 0 2] } {
append result $line\n
diff --git a/tests/constraints.tcl b/tests/constraints.tcl
index 45c9f9d..fa6011f 100644
--- a/tests/constraints.tcl
+++ b/tests/constraints.tcl
@@ -342,6 +342,12 @@ testConstraint haveTimes12BoldItalicUnderlineOverstrikeFont [expr {
([font actual {times 12 bold italic overstrike underline} -underline] eq "1") &&
([font actual {times 12 bold italic overstrike underline} -overstrike] eq "1")
}]
+set fixedFont {Courier 12} ; # warning: must be consistent with the files using the constraint below!
+set bigFont {Helvetica 24} ; # ditto
+testConstraint haveBigFontTwiceLargerThanTextFont [expr {
+ [font actual $fixedFont -size] * 2 <= [font actual $bigFont -size]
+}]
+unset fixedFont bigFont
# constraints for the visuals available
testConstraint pseudocolor8 [expr {
diff --git a/tests/dialog.test b/tests/dialog.test
index 78b6620..9790ef1 100644
--- a/tests/dialog.test
+++ b/tests/dialog.test
@@ -36,7 +36,7 @@ test dialog-2.1 {tk_dialog operation} -setup {
return $res
} -cleanup {
destroy .d
-} -result {0}
+} -result 0
test dialog-2.2 {tk_dialog operation} -setup {
proc HitReturn {w} {
event generate $w <Enter>
@@ -51,7 +51,7 @@ test dialog-2.2 {tk_dialog operation} -setup {
return $res
} -cleanup {
destroy .d
-} -result {1}
+} -result 1
test dialog-2.3 {tk_dialog operation} -body {
set x [after 5000 [list set tk::Priv(button) "no response"]]
after 100 destroy .d
@@ -60,7 +60,7 @@ test dialog-2.3 {tk_dialog operation} -body {
return $res
} -cleanup {
destroy .b
-} -result {-1}
+} -result -1
cleanupTests
return
diff --git a/tests/entry.test b/tests/entry.test
index 5f28ad8..ffa8ce2 100644
--- a/tests/entry.test
+++ b/tests/entry.test
@@ -3484,7 +3484,7 @@ test entry-20.7 {widget deletion with textvariable active} -body {
# SF bugs 607390 and 617446
set FOO init
entry .e -textvariable FOO -validate all \
- -vcmd {%W configure -bg white; format 1}
+ -validatecommand {%W configure -bg white; format 1}
bind .e <Destroy> { set FOO hello }
destroy .e
winfo exists .e
diff --git a/tests/font.test b/tests/font.test
index ca712be..69d3b15 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -122,7 +122,7 @@ test font-4.3 {font command: actual: arguments} -body {
} -returnCodes error -result {wrong # args: should be "font actual font ?-displayof window? ?option? ?--? ?char?"}
test font-4.4 {font command: actual: displayof specified, so skip to next} -body {
catch {font actual xyz -displayof . -size}
-} -result {0}
+} -result 0
test font-4.5 {font command: actual: displayof specified, so skip to next} -body {
lindex [font actual xyz -displayof .] 0
} -result {-family}
@@ -537,7 +537,7 @@ test font-12.2 {UpdateDependantFonts procedure: pings the widgets} -setup {
} -cleanup {
destroy .t.f
font delete xyz
-} -result {1}
+} -result 1
test font-13.1 {CreateNamedFont: new named font} -setup {
@@ -1682,14 +1682,14 @@ destroy .t.f
pack [label .t.f]
update
test font-27.1 {Tk_UnderlineTextLayout procedure: no underline chosen} -body {
- .t.f config -text "foo" -under -1
+ .t.f config -text "foo" -underline -1
} -result {}
test font-27.2 {Tk_UnderlineTextLayout procedure: underline not visible} -body {
.t.f config -text "000 00000" -wrap [expr $ax*7] -under 10
} -result {}
test font-27.3 {Tk_UnderlineTextLayout procedure: underline is visible} -body {
.t.f config -text "000 00000" -wrap [expr $ax*7] -under 5
- .t.f config -wrap -1 -under -1
+ .t.f config -wrap -1 -underline -1
} -result {}
destroy .t.f
@@ -1704,7 +1704,7 @@ update
test font-28.1 {Tk_PointToChar procedure: above all lines} -body {
csetup "000"
.t.c index text @-1,0
-} -result {0}
+} -result 0
test font-28.2 {Tk_PointToChar procedure: no chars} -body {
# After fixing the following bug:
#
@@ -1716,46 +1716,46 @@ test font-28.2 {Tk_PointToChar procedure: no chars} -body {
csetup ""
.t.c index text @100,100
-} -result {0}
+} -result 0
test font-28.3 {Tk_PointToChar procedure: loop test} -body {
csetup "000\n000\n000\n000"
.t.c index text @10000,0
-} -result {3}
+} -result 3
test font-28.4 {Tk_PointToChar procedure: intersect line} -body {
csetup "000\n000\n000"
.t.c index text @0,$ay
-} -result {4}
+} -result 4
test font-28.5 {Tk_PointToChar procedure: to the left of all chunks} -body {
csetup "000\n000\n000"
.t.c index text @-100,$ay
-} -result {4}
+} -result 4
test font-28.6 {Tk_PointToChar procedure: past any possible chunk} -body {
csetup "000\n000\n000"
.t.c index text @100000,$ay
-} -result {7}
+} -result 7
test font-28.7 {Tk_PointToChar procedure: which chunk on this line} -body {
csetup "000\n000\t000\t000\n000"
.t.c index text @[expr $ax*2],$ay
-} -result {6}
+} -result 6
test font-28.8 {Tk_PointToChar procedure: which chunk on this line} -body {
csetup "000\n000\t000\t000\n000"
.t.c index text @[expr $ax*10],$ay
-} -result {10}
+} -result 10
test font-28.9 {Tk_PointToChar procedure: in special chunk} -body {
csetup "000\n000\t000\t000\n000"
.t.c index text @[expr $ax*6],$ay
-} -result {7}
+} -result 7
test font-28.10 {Tk_PointToChar procedure: past all chars in chunk} -body {
csetup "000 0000000"
.t.c itemconfig text -width [expr $ax*5]
set x [.t.c index text @[expr $ax*5],0]
.t.c itemconfig text -width 0
return $x
-} -result {3}
+} -result 3
test font-28.11 {Tk_PointToChar procedure: below all chunks} -body {
csetup "000 0000000"
.t.c index text @0,1000000
-} -result {11}
+} -result 11
destroy .t.c
@@ -1802,7 +1802,7 @@ test font-30.1 {Tk_DistanceToTextLayout procedure: loop once} -body {
return $x
} -cleanup {
bind all <Enter> {}
-} -result {0}
+} -result 0
test font-30.2 {Tk_DistanceToTextLayout procedure: loop multiple} -body {
csetup "000\n000\n000"
.t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
@@ -1812,7 +1812,7 @@ test font-30.2 {Tk_DistanceToTextLayout procedure: loop multiple} -body {
return $x
} -cleanup {
bind all <Enter> {}
-} -result {5}
+} -result 5
test font-30.3 {Tk_DistanceToTextLayout procedure: loop to end} -body {
csetup "000\n0\n000"
.t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
@@ -1832,7 +1832,7 @@ test font-30.4 {Tk_DistanceToTextLayout procedure: hit a special char (tab)} -bo
return $x
} -cleanup {
bind all <Enter> {}
-} -result {3}
+} -result 3
test font-30.5 {Tk_DistanceToTextLayout procedure: ignore newline} -body {
csetup "000\n0\n000"
.t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
@@ -1885,7 +1885,7 @@ test font-30.9 {Tk_DistanceToTextLayout procedure: inside line} -body {
return $x
} -cleanup {
bind all <Enter> {}
-} -result {0}
+} -result 0
test font-30.10 {Tk_DistanceToTextLayout procedure: above line} -body {
csetup "0\n000"
.t.c bind all <Enter> {lappend x [.t.c index current @%x,%y]}
@@ -1915,7 +1915,7 @@ test font-30.12 {Tk_DistanceToTextLayout procedure: in line} -body {
return $x
} -cleanup {
bind all <Enter> {}
-} -result {3}
+} -result 3
.t.c itemconfig text -justify left
test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} -body {
csetup "000"
@@ -1926,7 +1926,7 @@ test font-30.13 {Tk_DistanceToTextLayout procedure: exact hit} -body {
return $x
} -cleanup {
bind all <Enter> {}
-} -result {1}
+} -result 1
destroy .t.c
@@ -1972,7 +1972,7 @@ test font-31.7 {TkIntersectAngledTextLayout procedure: bug [514ff64dd0]} -body {
# The text has been rotated 90 degrees around it's upper left corner,
# so it's enough to check with a small rectangle with small negative y coords.
.t.c find overlapping 5 -7 7 -5
-} -result {1}
+} -result 1
destroy .t.c
@@ -2183,7 +2183,7 @@ test font-37.3 {GetAttributeInfo procedure: size} -setup {
font config xyz -size
} -cleanup {
font delete xyz
-} -result {20}
+} -result 20
test font-37.4 {GetAttributeInfo procedure: weight} -setup {
catch {font delete xyz}
set x {}
@@ -2210,7 +2210,7 @@ test font-37.6 {GetAttributeInfo procedure: underline} -setup {
font config xyz -underline
} -cleanup {
font delete xyz
-} -result {1}
+} -result 1
test font-37.7 {GetAttributeInfo procedure: overstrike} -setup {
catch {font delete xyz}
set x {}
@@ -2219,7 +2219,7 @@ test font-37.7 {GetAttributeInfo procedure: overstrike} -setup {
font config xyz -overstrike
} -cleanup {
font delete xyz
-} -result {0}
+} -result 0
# In tests below, one field is set to "xyz" so that font name doesn't
@@ -2346,7 +2346,7 @@ test font-44.1 {TkFontGetPixels: size < 0} -constraints failsOnUbuntu -setup {
font actual {times -12} -size
} -cleanup {
tk scaling $oldscale
-} -result {24}
+} -result 24
test font-44.2 {TkFontGetPoints: size >= 0} -constraints {noExceed haveTimes12Font} -setup {
set oldscale [tk scaling]
} -body {
@@ -2354,7 +2354,7 @@ test font-44.2 {TkFontGetPoints: size >= 0} -constraints {noExceed haveTimes12Fo
font actual {times 12} -size
} -cleanup {
tk scaling $oldscale
-} -result {12}
+} -result 12
test font-45.1 {TkFontGetAliasList: no match} -body {
@@ -2371,7 +2371,7 @@ test font-45.3 {TkFontGetAliasList: match} -constraints {noExceed failsOnUbuntu}
set res [expr {[font actual {{times new roman} 10} -family] eq \
[font actual {times 10} -family]} ]
}
-} -result {1}
+} -result 1
test font-46.1 {font actual, with character, no option, no --} -body {
@@ -2407,7 +2407,7 @@ test font-47.1 {Bug f214b8ad5b} -body {
interp delete two
} -result {}
-test font-47.2 {Bug 3049518,TIP 608 - Canvas} -body {
+test font-47.2 {Bug 3049518 - Canvas} -body {
if {"MyFont" ni [font names]} {
font create MyFont -family "Liberation Sans" -size 13
}
@@ -2473,7 +2473,7 @@ test font-47.2 {Bug 3049518,TIP 608 - Canvas} -body {
unset -nocomplain ::results
} -result {{1 2} called-.t.c {1 2} called-.t.c {1 2} called-.t.c {1 2}}
-test font-47.3 {Bug 3049518, TIP 608 - Label} -body {
+test font-47.3 {Bug 3049518 - Label} -body {
if {"MyFont" ni [font names]} {
font create MyFont -family "Liberation Sans" -size 13
}
diff --git a/tests/fontchooser.test b/tests/fontchooser.test
index e2e404f..8587ece 100644
--- a/tests/fontchooser.test
+++ b/tests/fontchooser.test
@@ -79,7 +79,7 @@ test fontchooser-1.7 {tk fontchooser: usage} -returnCodes error -body {
test fontchooser-1.8 {tk fontchooser: usage} -returnCodes ok -body {
tk fontchooser configure -visible
-} -result {0}
+} -result 0
test fontchooser-1.9 {tk fontchooser: usage} -returnCodes error -body {
tk fontchooser configure -visible 1
@@ -155,7 +155,7 @@ test fontchooser-4.1 {fontchooser -font} -constraints scriptImpl -body {
Click ok
}
expr {$::testfont ne {}}
-} -result {1}
+} -result 1
test fontchooser-4.2 {fontchooser -font} -constraints scriptImpl -body {
start {
@@ -166,7 +166,7 @@ test fontchooser-4.2 {fontchooser -font} -constraints scriptImpl -body {
Click ok
}
expr {$::testfont ne {}}
-} -result {1}
+} -result 1
test fontchooser-4.3 {fontchooser -font} -constraints scriptImpl -body {
start {
@@ -177,7 +177,7 @@ test fontchooser-4.3 {fontchooser -font} -constraints scriptImpl -body {
Click ok
}
expr {$::testfont ne {}}
-} -result {1}
+} -result 1
test fontchooser-4.4 {fontchooser -font} -constraints {scriptImpl haveTimes14BoldFont} -body {
start {
diff --git a/tests/frame.test b/tests/frame.test
index 768b9e0..85ce6f9 100644
--- a/tests/frame.test
+++ b/tests/frame.test
@@ -12,9 +12,11 @@ namespace import ::tcltest::*
eval tcltest::configure $argv
tcltest::loadTestedCommands
+tcltest::testConstraint x11 [expr {[tk windowingsystem] eq "x11"}]
+
# eatColors --
-# Creates a toplevel window and allocates enough colors in it to
-# use up all the slots in the colormap.
+# Creates a toplevel window and allocates enough colors in it to use up all
+# the slots in an 8-bit colormap.
#
# Arguments:
# w - Name of toplevel window to create.
@@ -27,10 +29,10 @@ proc eatColors {w} {
pack $w.c
for {set y 0} {$y < 8} {incr y} {
for {set x 0} {$x < 40} {incr x} {
- set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0]
- $w.c create rectangle [expr 10*$x] [expr 20*$y] \
- [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \
- -fill $color
+ set color [format #%02x%02x%02x [expr {$x*6}] [expr {$y*30}] 0]
+ $w.c create rectangle [expr {10*$x}] [expr {20*$y}] \
+ [expr {10*$x + 10}] [expr {20*$y + 20}] -outline {} \
+ -fill $color
}
}
update
@@ -38,8 +40,8 @@ proc eatColors {w} {
# colorsFree --
#
-# Returns 1 if there appear to be free colormap entries in a window,
-# 0 otherwise.
+# Returns 1 if there appear to be free colormap entries in a window, 0
+# otherwise.
#
# Arguments:
# w - Name of window in which to check.
@@ -47,12 +49,34 @@ proc eatColors {w} {
# to see if there are colormap entries free.
proc colorsFree {w {red 31} {green 245} {blue 192}} {
- set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]]
- expr ([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green) \
- && ([lindex $vals 2]/256 == $blue)
+ lassign [winfo rgb $w [format "#%02x%02x%02x" $red $green $blue]] r g b
+ expr {($r/256 == $red) && ($g/256 == $green) && ($b/256 == $blue)}
}
+# uniq --
+#
+# Returns the unique items of a list in the order they first appear.
+#
+# Arguments:
+# list - The list to uniq-ify.
+proc uniq {list} {
+ set d {}
+ foreach item $list {
+ dict set d $item {}
+ }
+ return [dict keys $d]
+}
+# optnames --
+#
+# Returns the option names out of a list of option details.
+#
+# Arguments:
+# options - The option detail list.
+proc optnames {options} {
+ lsort [lmap desc $options {lindex $desc 0}]
+}
+
test frame-1.1 {frame configuration options} -setup {
deleteWindows
} -body {
@@ -66,10 +90,9 @@ test frame-1.2 {frame configuration options} -setup {
} -body {
frame .f -class NewFrame
.f configure -class Different
-} -cleanup {
+} -returnCodes error -cleanup {
deleteWindows
-} -returnCodes error -result {can't modify -class option after widget is created}
-
+} -result {can't modify -class option after widget is created}
test frame-1.3 {frame configuration options} -setup {
deleteWindows
} -body {
@@ -83,10 +106,9 @@ test frame-1.4 {frame configuration options} -setup {
} -body {
frame .f -colormap new
.f configure -colormap .
-} -cleanup {
+} -returnCodes error -cleanup {
deleteWindows
-} -returnCodes error -result {can't modify -colormap option after widget is created}
-
+} -result {can't modify -colormap option after widget is created}
test frame-1.5 {frame configuration options} -setup {
deleteWindows
} -body {
@@ -100,10 +122,9 @@ test frame-1.6 {frame configuration options} -setup {
} -body {
frame .f -visual default
.f configure -visual best
-} -cleanup {
+} -returnCodes error -cleanup {
deleteWindows
-} -returnCodes error -result {can't modify -visual option after widget is created}
-
+} -result {can't modify -visual option after widget is created}
test frame-1.7 {frame configuration options} -setup {
deleteWindows
} -body {
@@ -138,9 +159,9 @@ test frame-1.11 {frame configuration options} -setup {
} -body {
frame .f
.f configure -container 1
-} -cleanup {
+} -returnCodes error -cleanup {
deleteWindows
-} -returnCodes error -result {can't modify -container option after widget is created}
+} -result {can't modify -container option after widget is created}
test frame-1.12 {frame configuration options} -setup {
deleteWindows
} -body {
@@ -153,10 +174,10 @@ test frame-1.12 {frame configuration options} -setup {
}
}
eval frame .g $opts
- destroy .f .g
} -cleanup {
+ destroy .f .g
deleteWindows
-} -result {}
+} -result .g
destroy .f
frame .f
@@ -165,7 +186,7 @@ test frame-1.13 {frame configuration options} -body {
lindex [.f configure -background] 4
} -cleanup {
.f configure -background [lindex [.f configure -background] 3]
-} -result {#ff0000}
+} -result "#ff0000"
test frame-1.14 {frame configuration options} -body {
.f configure -background non-existent
} -returnCodes error -result {unknown color name "non-existent"}
@@ -174,7 +195,7 @@ test frame-1.15 {frame configuration options} -body {
lindex [.f configure -bd] 4
} -cleanup {
.f configure -bd [lindex [.f configure -bd] 3]
-} -result {4}
+} -result 4
test frame-1.16 {frame configuration options} -body {
.f configure -bd badValue
} -returnCodes error -result {bad screen distance "badValue"}
@@ -183,7 +204,7 @@ test frame-1.17 {frame configuration options} -body {
lindex [.f configure -bg] 4
} -cleanup {
.f configure -bg [lindex [.f configure -bg] 3]
-} -result {#00ff00}
+} -result "#00ff00"
test frame-1.18 {frame configuration options} -body {
.f configure -bg non-existent
} -returnCodes error -result {unknown color name "non-existent"}
@@ -192,7 +213,7 @@ test frame-1.19 {frame configuration options} -body {
lindex [.f configure -borderwidth] 4
} -cleanup {
.f configure -borderwidth [lindex [.f configure -borderwidth] 3]
-} -result {1}
+} -result 1
test frame-1.20 {frame configuration options} -body {
.f configure -borderwidth badValue
} -returnCodes error -result {bad screen distance "badValue"}
@@ -210,7 +231,7 @@ test frame-1.23 {frame configuration options} -body {
lindex [.f configure -height] 4
} -cleanup {
.f configure -height [lindex [.f configure -height] 3]
-} -result {100}
+} -result 100
test frame-1.24 {frame configuration options} -body {
.f configure -height not_a_number
} -returnCodes error -result {bad screen distance "not_a_number"}
@@ -219,7 +240,7 @@ test frame-1.25 {frame configuration options} -body {
lindex [.f configure -highlightbackground] 4
} -cleanup {
.f configure -highlightbackground [lindex [.f configure -highlightbackground] 3]
-} -result {#112233}
+} -result "#112233"
test frame-1.26 {frame configuration options} -body {
.f configure -highlightbackground ugly
} -returnCodes error -result {unknown color name "ugly"}
@@ -228,7 +249,7 @@ test frame-1.27 {frame configuration options} -body {
lindex [.f configure -highlightcolor] 4
} -cleanup {
.f configure -highlightcolor [lindex [.f configure -highlightcolor] 3]
-} -result {#123456}
+} -result "#123456"
test frame-1.28 {frame configuration options} -body {
.f configure -highlightcolor non-existent
} -returnCodes error -result {unknown color name "non-existent"}
@@ -237,7 +258,7 @@ test frame-1.29 {frame configuration options} -body {
lindex [.f configure -highlightthickness] 4
} -cleanup {
.f configure -highlightthickness [lindex [.f configure -highlightthickness] 3]
-} -result {6}
+} -result 6
test frame-1.30 {frame configuration options} -body {
.f configure -highlightthickness badValue
} -returnCodes error -result {bad screen distance "badValue"}
@@ -246,7 +267,7 @@ test frame-1.31 {frame configuration options} -body {
lindex [.f configure -padx] 4
} -cleanup {
.f configure -padx [lindex [.f configure -padx] 3]
-} -result {3}
+} -result 3
test frame-1.32 {frame configuration options} -body {
.f configure -padx badValue
} -returnCodes error -result {bad screen distance "badValue"}
@@ -255,7 +276,7 @@ test frame-1.33 {frame configuration options} -body {
lindex [.f configure -pady] 4
} -cleanup {
.f configure -pady [lindex [.f configure -pady] 3]
-} -result {4}
+} -result 4
test frame-1.34 {frame configuration options} -body {
.f configure -pady badValue
} -returnCodes error -result {bad screen distance "badValue"}
@@ -265,9 +286,9 @@ test frame-1.35 {frame configuration options} -body {
} -cleanup {
.f configure -relief [lindex [.f configure -relief] 3]
} -result {ridge}
-test frame-1.36 {frame configuration options} -body {
+test frame-1.36 {frame configuration options} -returnCodes error -body {
.f configure -relief badValue
-} -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}
+} -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}
test frame-1.37 {frame configuration options} -body {
.f configure -takefocus {any string}
lindex [.f configure -takefocus] 4
@@ -279,13 +300,12 @@ test frame-1.38 {frame configuration options} -body {
lindex [.f configure -width] 4
} -cleanup {
.f configure -width [lindex [.f configure -width] 3]
-} -result {32}
+} -result 32
test frame-1.39 {frame configuration options} -body {
.f configure -width badValue
} -returnCodes error -result {bad screen distance "badValue"}
destroy .f
-
test frame-2.1 {toplevel configuration options} -setup {
deleteWindows
} -body {
@@ -301,10 +321,9 @@ test frame-2.2 {toplevel configuration options} -setup {
toplevel .t -width 200 -height 100 -class NewClass
wm geometry .t +0+0
.t configure -class Another
-} -cleanup {
+} -returnCodes error -cleanup {
deleteWindows
-} -returnCodes error -result {can't modify -class option after widget is created}
-
+} -result {can't modify -class option after widget is created}
test frame-2.3 {toplevel configuration options} -setup {
deleteWindows
} -body {
@@ -320,23 +339,21 @@ test frame-2.4 {toplevel configuration options} -setup {
toplevel .t -width 200 -height 100 -colormap new
wm geometry .t +0+0
.t configure -colormap .
-} -cleanup {
+} -returnCodes error -cleanup {
deleteWindows
-} -returnCodes error -result {can't modify -colormap option after widget is created}
-
+} -result {can't modify -colormap option after widget is created}
test frame-2.5 {toplevel configuration options} -setup {
deleteWindows
} -body {
toplevel .t -width 200 -height 100
wm geometry .t +0+0
.t configure -container 1
-} -cleanup {
+} -returnCodes error -cleanup {
deleteWindows
-} -returnCodes error -result {can't modify -container option after widget is created}
+} -result {can't modify -container option after widget is created}
test frame-2.6 {toplevel configuration options} -setup {
deleteWindows
} -body {
- catch {destroy .t}
toplevel .t -width 200 -height 100
wm geometry .t +0+0
catch {.t configure -container 1}
@@ -344,7 +361,6 @@ test frame-2.6 {toplevel configuration options} -setup {
} -cleanup {
deleteWindows
} -result {-container container Container 0 0}
-
test frame-2.7 {toplevel configuration options} -setup {
deleteWindows
} -body {
@@ -352,26 +368,18 @@ test frame-2.7 {toplevel configuration options} -setup {
} -cleanup {
deleteWindows
} -returnCodes error -result {bad window path name "bogus"}
-
-
-test frame-2.8 {toplevel configuration options} -constraints {
- win
-} -setup {
+test frame-2.8 {toplevel configuration options} -constraints win -setup {
deleteWindows
} -body {
- catch {destroy .t}
toplevel .t -width 200 -height 100
wm geometry .t +0+0
.t configure -use 0x44022
} -cleanup {
deleteWindows
} -returnCodes error -result {window "0x44022" doesn't exist}
-test frame-2.9 {toplevel configuration options} -constraints {
- win
-} -setup {
+test frame-2.9 {toplevel configuration options} -constraints win -setup {
deleteWindows
} -body {
- catch {destroy .t}
toplevel .t -width 200 -height 100
wm geometry .t +0+0
catch {.t configure -use 0x44022}
@@ -379,25 +387,18 @@ test frame-2.9 {toplevel configuration options} -constraints {
} -cleanup {
deleteWindows
} -result {-use use Use {} {}}
-
-test frame-2.10 {toplevel configuration options} -constraints {
- nonwin
-} -setup {
+test frame-2.10 {toplevel configuration options} -constraints nonwin -setup {
deleteWindows
} -body {
- catch {destroy .t}
toplevel .t -width 200 -height 100
wm geometry .t +0+0
.t configure -use 0x44022
} -cleanup {
deleteWindows
} -returnCodes error -result {can't modify -use option after widget is created}
-test frame-2.11 {toplevel configuration options} -constraints {
- nonwin
-} -setup {
+test frame-2.11 {toplevel configuration options} -constraints nonwin -setup {
deleteWindows
} -body {
- catch {destroy .t}
toplevel .t -width 200 -height 100
wm geometry .t +0+0
catch {.t configure -use 0x44022}
@@ -405,11 +406,9 @@ test frame-2.11 {toplevel configuration options} -constraints {
} -cleanup {
deleteWindows
} -result {-use use Use {} {}}
-
test frame-2.12 {toplevel configuration options} -setup {
deleteWindows
} -body {
- catch {destroy .t}
toplevel .t -width 200 -height 100 -visual default
wm geometry .t +0+0
.t configure -visual
@@ -419,40 +418,41 @@ test frame-2.12 {toplevel configuration options} -setup {
test frame-2.13 {toplevel configuration options} -setup {
deleteWindows
} -body {
- catch {destroy .t}
toplevel .t -width 200 -height 100 -visual default
wm geometry .t +0+0
.t configure -visual best
-} -cleanup {
+} -returnCodes error -cleanup {
deleteWindows
-} -returnCodes error -result {can't modify -visual option after widget is created}
-
+} -result {can't modify -visual option after widget is created}
test frame-2.14 {toplevel configuration options} -setup {
deleteWindows
} -body {
toplevel .t -width 200 -height 100 -visual who_knows?
-} -cleanup {
+} -returnCodes error -cleanup {
deleteWindows
-} -returnCodes error -result {unknown or ambiguous visual name "who_knows?": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}
-test frame-2.15 {toplevel configuration options} -constraints haveDISPLAY -setup {
+} -result {unknown or ambiguous visual name "who_knows?": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}
+set expectedScreen ""
+if {[tcltest::testConstraint haveDISPLAY]} {
+ set expectedScreen [list -screen screen Screen {} $env(DISPLAY)]
+}
+test frame-2.15 {toplevel configuration options} -constraints {x11 haveDISPLAY} -setup {
deleteWindows
} -body {
toplevel .t -width 200 -height 100 -screen $env(DISPLAY)
wm geometry .t +0+0
- string compare [.t configure -screen] "-screen screen Screen {} $env(DISPLAY)"
+ .t configure -screen
} -cleanup {
deleteWindows
-} -result {0}
-test frame-2.16 {toplevel configuration options} -constraints haveDISPLAY -setup {
+} -result $expectedScreen
+test frame-2.16 {toplevel configuration options} -constraints {x11 haveDISPLAY} -setup {
deleteWindows
} -body {
toplevel .t -width 200 -height 100 -screen $env(DISPLAY)
wm geometry .t +0+0
.t configure -screen another
-} -cleanup {
+} -returnCodes error -cleanup {
deleteWindows
-} -returnCodes error -result {can't modify -screen option after widget is created}
-
+} -result {can't modify -screen option after widget is created}
test frame-2.17 {toplevel configuration options} -setup {
deleteWindows
} -body {
@@ -466,9 +466,9 @@ test frame-2.18 {toplevel configuration options} -setup {
toplevel .t -container 1 -width 300 -height 120
wm geometry .t +0+0
toplevel .x -container 1 -use [winfo id .t]
-} -cleanup {
+} -returnCodes error -cleanup {
deleteWindows
-} -returnCodes error -result {windows cannot have both the -use and the -container option set}
+} -result {windows cannot have both the -use and the -container option set}
test frame-2.19 {toplevel configuration options} -setup {
deleteWindows
set opts {}
@@ -481,11 +481,10 @@ test frame-2.19 {toplevel configuration options} -setup {
}
}
eval toplevel .g $opts
- destroy .f .g
} -cleanup {
+ destroy .f .g
deleteWindows
-} -result {}
-
+} -result .g
destroy .t
toplevel .t -width 300 -height 150
@@ -494,28 +493,28 @@ update
test frame-2.20 {toplevel configuration options} -body {
.t configure -background #ff0000
lindex [.t configure -background] 4
-} -result {#ff0000}
+} -result "#ff0000"
test frame-2.21 {toplevel configuration options} -body {
.t configure -background non-existent
} -returnCodes error -result {unknown color name "non-existent"}
test frame-2.22 {toplevel configuration options} -body {
.t configure -bd 4
lindex [.t configure -bd] 4
-} -result {4}
+} -result 4
test frame-2.23 {toplevel configuration options} -body {
.t configure -bd badValue
} -returnCodes error -result {bad screen distance "badValue"}
test frame-2.24 {toplevel configuration options} -body {
.t configure -bg #00ff00
lindex [.t configure -bg] 4
-} -result {#00ff00}
+} -result "#00ff00"
test frame-2.25 {toplevel configuration options} -body {
.t configure -bg non-existent
} -returnCodes error -result {unknown color name "non-existent"}
test frame-2.26 {toplevel configuration options} -body {
.t configure -borderwidth 1.3
lindex [.t configure -borderwidth] 4
-} -result {1}
+} -result 1
test frame-2.27 {toplevel configuration options} -body {
.t configure -borderwidth badValue
} -returnCodes error -result {bad screen distance "badValue"}
@@ -529,35 +528,35 @@ test frame-2.29 {toplevel configuration options} -body {
test frame-2.30 {toplevel configuration options} -body {
.t configure -height 100
lindex [.t configure -height] 4
-} -result {100}
+} -result 100
test frame-2.31 {toplevel configuration options} -body {
.t configure -height not_a_number
} -returnCodes error -result {bad screen distance "not_a_number"}
test frame-2.32 {toplevel configuration options} -body {
.t configure -highlightcolor #123456
lindex [.t configure -highlightcolor] 4
-} -result {#123456}
+} -result "#123456"
test frame-2.33 {toplevel configuration options} -body {
.t configure -highlightcolor non-existent
} -returnCodes error -result {unknown color name "non-existent"}
test frame-2.34 {toplevel configuration options} -body {
.t configure -highlightthickness 3
lindex [.t configure -highlightthickness] 4
-} -result {3}
+} -result 3
test frame-2.35 {toplevel configuration options} -body {
.t configure -highlightthickness badValue
} -returnCodes error -result {bad screen distance "badValue"}
test frame-2.36 {toplevel configuration options} -body {
.t configure -padx 3
lindex [.t configure -padx] 4
-} -result {3}
+} -result 3
test frame-2.37 {toplevel configuration options} -body {
.t configure -padx badValue
} -returnCodes error -result {bad screen distance "badValue"}
test frame-2.38 {toplevel configuration options} -body {
.t configure -pady 4
lindex [.t configure -pady] 4
-} -result {4}
+} -result 4
test frame-2.39 {toplevel configuration options} -body {
.t configure -pady badValue
} -returnCodes error -result {bad screen distance "badValue"}
@@ -565,22 +564,21 @@ test frame-2.40 {toplevel configuration options} -body {
.t configure -relief ridge
lindex [.t configure -relief] 4
} -result {ridge}
-test frame-2.41 {toplevel configuration options} -body {
+test frame-2.41 {toplevel configuration options} -returnCodes error -body {
.t configure -relief badValue
-} -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}
+} -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}
test frame-2.42 {toplevel configuration options} -body {
.t configure -width 32
lindex [.t configure -width] 4
-} -result {32}
+} -result 32
test frame-2.43 {toplevel configuration options} -body {
.t configure -width badValue
} -returnCodes error -result {bad screen distance "badValue"}
destroy .t
-
-test frame-3.1 {TkCreateFrame procedure} -body {
+test frame-3.1 {TkCreateFrame procedure} -returnCodes error -body {
frame
-} -returnCodes error -result {wrong # args: should be "frame pathName ?-option value ...?"}
+} -result {wrong # args: should be "frame pathName ?-option value ...?"}
test frame-3.2 {TkCreateFrame procedure} -setup {
deleteWindows
frame .f
@@ -610,7 +608,6 @@ test frame-3.4 {TkCreateFrame procedure} -setup {
} -cleanup {
deleteWindows
} -result {350 black 90}
-
# Be sure that the -class, -colormap, and -visual options are processed
# before configuring the widget.
test frame-3.5 {TkCreateFrame procedure} -setup {
@@ -679,42 +676,40 @@ test frame-3.10 {TkCreateFrame procedure, -use option} -constraints {
destroy .t
option clear
} -result {0 0 140 300}
-
-# The tests below require specific display characteristics (i.e. that
-# they are run on a pseudocolor display of depth 8). Even so, they
-# are non-portable: some machines don't seem to ever run out of
-# colors.
+# The tests below require specific display characteristics (i.e. that they are
+# run on a pseudocolor display of depth 8). Even so, they are non-portable:
+# some machines don't seem to ever run out of colors.
if {[testConstraint defaultPseudocolor8]} {
eatColors .t1
}
test frame-3.11 {TkCreateFrame procedure} -constraints {
- defaultPseudocolor8 nonPortable
+ defaultPseudocolor8 nonPortable
} -setup {
- deleteWindows
+ destroy .t
} -body {
toplevel .t -width 300 -height 200 -bg #475601
wm geometry .t +0+0
update
colorsFree .t
} -cleanup {
- deleteWindows
-} -result {0}
+ destroy .t
+} -result 0
test frame-3.12 {TkCreateFrame procedure} -constraints {
- defaultPseudocolor8 nonPortable
+ defaultPseudocolor8 nonPortable
} -setup {
- deleteWindows
+ destroy .t
} -body {
toplevel .t -width 300 -height 200 -bg #475601 -colormap new
wm geometry .t +0+0
update
colorsFree .t
} -cleanup {
- deleteWindows
-} -result {1}
+ destroy .t
+} -result 1
test frame-3.13 {TkCreateFrame procedure} -constraints {
- defaultPseudocolor8 nonPortable
+ defaultPseudocolor8 nonPortable
} -setup {
- deleteWindows
+ destroy .t
} -body {
option add *t.class Toplevel2
option add *Toplevel2.colormap new
@@ -724,12 +719,12 @@ test frame-3.13 {TkCreateFrame procedure} -constraints {
option clear
colorsFree .t
} -cleanup {
- deleteWindows
-} -result {1}
+ destroy .t
+} -result 1
test frame-3.14 {TkCreateFrame procedure} -constraints {
- defaultPseudocolor8 nonPortable
+ defaultPseudocolor8 nonPortable
} -setup {
- deleteWindows
+ destroy .t
} -body {
option add *t.class Toplevel3
option add *Toplevel3.Colormap new
@@ -739,12 +734,12 @@ test frame-3.14 {TkCreateFrame procedure} -constraints {
option clear
colorsFree .t
} -cleanup {
- deleteWindows
-} -result {1}
+ destroy .t
+} -result 1
test frame-3.15 {TkCreateFrame procedure, -use and -colormap} -constraints {
defaultPseudocolor8 unix nonPortable
} -setup {
- deleteWindows
+ destroy .t
} -body {
toplevel .t -container 1 -width 300 -height 120
wm geometry .t +0+0
@@ -755,21 +750,21 @@ test frame-3.15 {TkCreateFrame procedure, -use and -colormap} -constraints {
destroy .t
} -result {0 1}
test frame-3.16 {TkCreateFrame procedure} -constraints {
- defaultPseudocolor8 nonPortable
+ defaultPseudocolor8 nonPortable
} -setup {
- deleteWindows
+ destroy .t
} -body {
toplevel .t -width 300 -height 200 -bg #475601 -visual default
wm geometry .t +0+0
update
colorsFree .t
} -cleanup {
- deleteWindows
-} -result {0}
+ destroy .t
+} -result 0
test frame-3.17 {TkCreateFrame procedure} -constraints {
- defaultPseudocolor8 nonPortable
+ defaultPseudocolor8 nonPortable
} -setup {
- deleteWindows
+ destroy .t
} -body {
toplevel .t -width 300 -height 200 -bg #475601 -visual default \
-colormap new
@@ -777,24 +772,24 @@ test frame-3.17 {TkCreateFrame procedure} -constraints {
update
colorsFree .t
} -cleanup {
- deleteWindows
-} -result {1}
+ destroy .t
+} -result 1
test frame-3.18 {TkCreateFrame procedure} -constraints {
- defaultPseudocolor8 haveGrayscale8 nonPortable
+ defaultPseudocolor8 haveGrayscale8 nonPortable
} -setup {
- deleteWindows
+ destroy .t
} -body {
toplevel .t -visual {grayscale 8} -width 300 -height 200 -bg #434343
wm geometry .t +0+0
update
colorsFree .t 131 131 131
} -cleanup {
- deleteWindows
-} -result {1}
+ destroy .t
+} -result 1
test frame-3.19 {TkCreateFrame procedure} -constraints {
- defaultPseudocolor8 haveGrayscale8 nonPortable
+ defaultPseudocolor8 haveGrayscale8 nonPortable
} -setup {
- deleteWindows
+ destroy .t
} -body {
option add *t.class T4
option add *T4.visual {grayscale 8}
@@ -804,14 +799,13 @@ test frame-3.19 {TkCreateFrame procedure} -constraints {
option clear
list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]
} -cleanup {
- deleteWindows
+ destroy .t
} -result {1 {grayscale 8}}
test frame-3.20 {TkCreateFrame procedure} -constraints {
- defaultPseudocolor8 haveGrayscale8 nonPortable
+ defaultPseudocolor8 haveGrayscale8 nonPortable
} -setup {
- deleteWindows
+ destroy .t
} -body {
- set x ok
option add *t.class T5
option add *T5.Visual {grayscale 8}
toplevel .t -width 300 -height 200 -bg #434343
@@ -820,25 +814,23 @@ test frame-3.20 {TkCreateFrame procedure} -constraints {
option clear
list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]
} -cleanup {
- deleteWindows
+ destroy .t
} -result {1 {grayscale 8}}
test frame-3.21 {TkCreateFrame procedure} -constraints {
- defaultPseudocolor8 haveGrayscale8 nonPortable
+ defaultPseudocolor8 haveGrayscale8 nonPortable
} -setup {
- deleteWindows
+ destroy .t
} -body {
- set x ok
toplevel .t -visual {grayscale 8} -width 300 -height 200 -bg #434343
wm geometry .t +0+0
update
colorsFree .t 131 131 131
} -cleanup {
- deleteWindows
-} -result {1}
+ destroy .t
+} -result 1
if {[testConstraint defaultPseudocolor8]} {
destroy .t1
}
-
test frame-3.22 {TkCreateFrame procedure, default dimensions} -setup {
deleteWindows
} -body {
@@ -865,7 +857,6 @@ test frame-3.24 {TkCreateFrame procedure} -setup {
wm geometry .t +0+0
} -returnCodes error -result {unknown option "-bogus"}
-
test frame-4.1 {TkCreateFrame procedure} -setup {
deleteWindows
} -body {
@@ -880,7 +871,6 @@ test frame-4.2 {TkCreateFrame procedure} -setup {
deleteWindows
} -result {.f 1}
-
frame .f -highlightcolor black
test frame-5.1 {FrameWidgetCommand procedure} -body {
.f
@@ -908,10 +898,9 @@ test frame-5.7 {FrameWidgetCommand procedure, cget option} -setup {
} -cleanup {
destroy .t
} -returnCodes ok -match glob -result *
-
test frame-5.8 {FrameWidgetCommand procedure, configure option} -body {
- llength [.f configure]
-} -result {18}
+ optnames [.f configure]
+} -result {-background -bd -bg -borderwidth -class -colormap -container -cursor -height -highlightbackground -highlightcolor -highlightthickness -padx -pady -relief -takefocus -visual -width}
test frame-5.9 {FrameWidgetCommand procedure, configure option} -body {
.f configure -gorp
} -returnCodes error -result {unknown option "-gorp"}
@@ -925,8 +914,8 @@ test frame-5.12 {FrameWidgetCommand procedure} -body {
.f swizzle
} -returnCodes error -result {bad option "swizzle": must be cget or configure}
test frame-5.13 {FrameWidgetCommand procedure, configure option} -body {
- llength [. configure]
-} -result {21}
+ optnames [. configure]
+} -result {-background -bd -bg -borderwidth -class -colormap -container -cursor -height -highlightbackground -highlightcolor -highlightthickness -menu -padx -pady -relief -screen -takefocus -use -visual -width}
destroy .f
test frame-6.1 {ConfigureFrame procedure} -setup {
@@ -1006,7 +995,6 @@ test frame-8.2 {FrameCmdDeletedProc procedure} -setup {
# This one fails with the dash-patch!!!! Still don't know why :-(
#
#test frame-8.3 {FrameCmdDeletedProc procedure} -setup {
-# eval destroy [winfo children .]
# deleteWindows
#} -body {
# toplevel .f1 -menu .m
@@ -1017,7 +1005,6 @@ test frame-8.2 {FrameCmdDeletedProc procedure} -setup {
# update
# list [info command .f*] [winfo children .]
#} -cleanup {
-# eval destroy [winfo children .]
# deleteWindows
#} -result {{} .m}
@@ -1040,7 +1027,7 @@ test frame-9.2 {MapFrame procedure} -setup {
destroy .t
update
winfo exists .t
-} -result {0}
+} -result 0
test frame-9.3 {MapFrame procedure, window deleted while mapping} -setup {
deleteWindows
} -body {
@@ -1056,21 +1043,16 @@ test frame-9.3 {MapFrame procedure, window deleted while mapping} -setup {
winfo exists .t
} -cleanup {
deleteWindows
-} -result {0}
-
+} -result 0
test frame-10.1 {frame widget vs hidden commands} -setup {
deleteWindows
} -body {
- set l [interp hidden]
frame .t
interp hide {} .t
destroy .t
- set res1 [list [winfo children .] [interp hidden]]
- set res2 [list {} $l]
- expr {$res1 eq $res2}
-} -result 1
-
+ list [winfo children .] [lsort [interp hidden]]
+} -result [list {} [lsort [interp hidden]]]
test frame-11.1 {TkInstallFrameMenu} -setup {
deleteWindows
@@ -1085,8 +1067,8 @@ test frame-11.1 {TkInstallFrameMenu} -setup {
} -result {.t}
test frame-11.2 {TkInstallFrameMenu - frame renamed} -setup {
deleteWindows
-} -body {
catch {rename foo {}}
+} -body {
menu .m1
.m1 add cascade -menu .m1.system
menu .m1.system -tearoff 0
@@ -1097,7 +1079,6 @@ test frame-11.2 {TkInstallFrameMenu - frame renamed} -setup {
deleteWindows
} -result {}
-
test frame-12.1 {FrameWorldChanged procedure} -setup {
deleteWindows
} -body {
@@ -1117,13 +1098,10 @@ test frame-12.2 {FrameWorldChanged procedure} -setup {
set font {helvetica 12}
labelframe .f -highlightthickness 1 -bd 3 -padx 1 -pady 2 -font $font \
-text "Mupp"
- set fh [expr {[font metrics $font -linespace] + 2 - 3}]
- set fw [expr {[font measure $font "Mupp"] + 2 - 3}]
- if {$fw < 0} {set fw 0}
- if {$fh < 0} {set fh 0}
+ set fh [expr {max([font metrics $font -linespace] + 2 - 3, 0)}]
+ set fw [expr {max([font measure $font "Mupp"] + 2 - 3, 0)}]
place .f -x 0 -y 0 -width 100 -height 100
pack [frame .f.f] -fill both -expand 1
-
set result {}
foreach lp {nw n ne en e es se s sw ws w wn} {
.f configure -labelanchor $lp
@@ -1138,9 +1116,10 @@ test frame-12.2 {FrameWorldChanged procedure} -setup {
w* {incr expx $fw ; incr expw -$fw}
e* {incr expw -$fw}
}
- lappend result [expr {\
- [winfo x .f.f] == $expx && [winfo y .f.f] == $expy &&\
- [winfo width .f.f] == $expw && [winfo height .f.f] == $exph}]
+ lappend result [expr {
+ [winfo x .f.f] == $expx && [winfo y .f.f] == $expy &&
+ [winfo width .f.f] == $expw && [winfo height .f.f] == $exph
+ }]
}
return $result
} -cleanup {
@@ -1166,11 +1145,10 @@ test frame-12.3 {FrameWorldChanged procedure} -setup {
} -cleanup {
deleteWindows
font delete myfont
-} -result {0}
-
+} -result 0
test frame-13.1 {labelframe configuration options} -setup {
- deleteWindows
+ deleteWindows
} -body {
labelframe .f -class NewFrame
.f configure -class
@@ -1182,9 +1160,9 @@ test frame-13.2 {labelframe configuration options} -setup {
} -body {
labelframe .f -class NewFrame
.f configure -class Different
-} -cleanup {
+} -returnCodes error -cleanup {
deleteWindows
-} -returnCodes error -result {can't modify -class option after widget is created}
+} -result {can't modify -class option after widget is created}
test frame-13.3 {labelframe configuration options} -setup {
deleteWindows
} -body {
@@ -1233,10 +1211,9 @@ test frame-13.9 {labelframe configuration options} -setup {
} -body {
labelframe .f
.f configure -container 1
-} -cleanup {
+} -returnCodes error -cleanup {
deleteWindows
-} -returnCodes error -result {can't modify -container option after widget is created}
-
+} -result {can't modify -container option after widget is created}
destroy .f
labelframe .f
test frame-13.10 {labelframe configuration options} -body {
@@ -1244,36 +1221,36 @@ test frame-13.10 {labelframe configuration options} -body {
lindex [.f configure -background] 4
} -cleanup {
.f configure -background [lindex [.f configure -background] 3]
-} -result {#ff0000}
+} -result "#ff0000"
test frame-13.11 {labelframe configuration options} -body {
- .f configure -background non-existent
+ .f configure -background non-existent
} -returnCodes error -result {unknown color name "non-existent"}
test frame-13.12 {labelframe configuration options} -body {
.f configure -bd 4
lindex [.f configure -bd] 4
} -cleanup {
.f configure -bd [lindex [.f configure -bd] 3]
-} -result {4}
+} -result 4
test frame-13.13 {labelframe configuration options} -body {
- .f configure -bd badValue
+ .f configure -bd badValue
} -returnCodes error -result {bad screen distance "badValue"}
test frame-13.14 {labelframe configuration options} -body {
.f configure -bg #00ff00
lindex [.f configure -bg] 4
} -cleanup {
.f configure -bg [lindex [.f configure -bg] 3]
-} -result {#00ff00}
+} -result "#00ff00"
test frame-13.15 {labelframe configuration options} -body {
- .f configure -bg non-existent
+ .f configure -bg non-existent
} -returnCodes error -result {unknown color name "non-existent"}
test frame-13.16 {labelframe configuration options} -body {
.f configure -borderwidth 1.3
lindex [.f configure -borderwidth] 4
} -cleanup {
.f configure -borderwidth [lindex [.f configure -borderwidth] 3]
-} -result {1}
+} -result 1
test frame-13.17 {labelframe configuration options} -body {
- .f configure -borderwidth badValue
+ .f configure -borderwidth badValue
} -returnCodes error -result {bad screen distance "badValue"}
test frame-13.18 {labelframe configuration options} -body {
.f configure -cursor arrow
@@ -1282,16 +1259,16 @@ test frame-13.18 {labelframe configuration options} -body {
.f configure -cursor [lindex [.f configure -cursor] 3]
} -result {arrow}
test frame-13.19 {labelframe configuration options} -body {
- .f configure -cursor badValue
+ .f configure -cursor badValue
} -returnCodes error -result {bad cursor spec "badValue"}
test frame-13.20 {labelframe configuration options} -body {
.f configure -fg #0000ff
lindex [.f configure -fg] 4
} -cleanup {
.f configure -fg [lindex [.f configure -fg] 3]
-} -result {#0000ff}
+} -result "#0000ff"
test frame-13.21 {labelframe configuration options} -body {
- .f configure -fg non-existent
+ .f configure -fg non-existent
} -returnCodes error -result {unknown color name "non-existent"}
test frame-13.22 {labelframe configuration options} -body {
.f configure -font {courier 8}
@@ -1304,45 +1281,45 @@ test frame-13.23 {labelframe configuration options} -body {
lindex [.f configure -foreground] 4
} -cleanup {
.f configure -foreground [lindex [.f configure -foreground] 3]
-} -result {#ff0000}
+} -result "#ff0000"
test frame-13.24 {labelframe configuration options} -body {
- .f configure -foreground non-existent
+ .f configure -foreground non-existent
} -returnCodes error -result {unknown color name "non-existent"}
test frame-13.25 {labelframe configuration options} -body {
.f configure -height 100
lindex [.f configure -height] 4
} -cleanup {
.f configure -height [lindex [.f configure -height] 3]
-} -result {100}
+} -result 100
test frame-13.26 {labelframe configuration options} -body {
- .f configure -height not_a_number
+ .f configure -height not_a_number
} -returnCodes error -result {bad screen distance "not_a_number"}
test frame-13.27 {labelframe configuration options} -body {
.f configure -highlightbackground #112233
lindex [.f configure -highlightbackground] 4
} -cleanup {
.f configure -highlightbackground [lindex [.f configure -highlightbackground] 3]
-} -result {#112233}
+} -result "#112233"
test frame-13.28 {labelframe configuration options} -body {
- .f configure -highlightbackground ugly
+ .f configure -highlightbackground ugly
} -returnCodes error -result {unknown color name "ugly"}
test frame-13.29 {labelframe configuration options} -body {
.f configure -highlightcolor #123456
lindex [.f configure -highlightcolor] 4
} -cleanup {
.f configure -highlightcolor [lindex [.f configure -highlightcolor] 3]
-} -result {#123456}
+} -result "#123456"
test frame-13.30 {labelframe configuration options} -body {
- .f configure -highlightcolor non-existent
+ .f configure -highlightcolor non-existent
} -returnCodes error -result {unknown color name "non-existent"}
test frame-13.31 {labelframe configuration options} -body {
.f configure -highlightthickness 6
lindex [.f configure -highlightthickness] 4
} -cleanup {
.f configure -highlightthickness [lindex [.f configure -highlightthickness] 3]
-} -result {6}
+} -result 6
test frame-13.32 {labelframe configuration options} -body {
- .f configure -highlightthickness badValue
+ .f configure -highlightthickness badValue
} -returnCodes error -result {bad screen distance "badValue"}
test frame-13.33 {labelframe configuration options} -body {
.f configure -labelanchor se
@@ -1350,26 +1327,26 @@ test frame-13.33 {labelframe configuration options} -body {
} -cleanup {
.f configure -labelanchor [lindex [.f configure -labelanchor] 3]
} -result {se}
-test frame-13.34 {labelframe configuration options} -body {
- .f configure -labelanchor badValue
-} -returnCodes error -result {bad labelanchor "badValue": must be e, en, es, n, ne, nw, s, se, sw, w, wn, or ws}
+test frame-13.34 {labelframe configuration options} -returnCodes error -body {
+ .f configure -labelanchor badValue
+} -result {bad labelanchor "badValue": must be e, en, es, n, ne, nw, s, se, sw, w, wn, or ws}
test frame-13.35 {labelframe configuration options} -body {
.f configure -padx 3
lindex [.f configure -padx] 4
} -cleanup {
.f configure -padx [lindex [.f configure -padx] 3]
-} -result {3}
+} -result 3
test frame-13.36 {labelframe configuration options} -body {
- .f configure -padx badValue
+ .f configure -padx badValue
} -returnCodes error -result {bad screen distance "badValue"}
test frame-13.37 {labelframe configuration options} -body {
.f configure -pady 4
lindex [.f configure -pady] 4
} -cleanup {
.f configure -pady [lindex [.f configure -pady] 3]
-} -result {4}
+} -result 4
test frame-13.38 {labelframe configuration options} -body {
- .f configure -pady badValue
+ .f configure -pady badValue
} -returnCodes error -result {bad screen distance "badValue"}
test frame-13.39 {labelframe configuration options} -body {
.f configure -relief ridge
@@ -1377,9 +1354,9 @@ test frame-13.39 {labelframe configuration options} -body {
} -cleanup {
.f configure -relief [lindex [.f configure -relief] 3]
} -result {ridge}
-test frame-13.40 {labelframe configuration options} -body {
- .f configure -relief badValue
-} -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}
+test frame-13.40 {labelframe configuration options} -returnCodes error -body {
+ .f configure -relief badValue
+} -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}
test frame-13.41 {labelframe configuration options} -body {
.f configure -takefocus {any string}
lindex [.f configure -takefocus] 4
@@ -1397,13 +1374,12 @@ test frame-13.43 {labelframe configuration options} -body {
lindex [.f configure -width] 4
} -cleanup {
.f configure -width [lindex [.f configure -width] 3]
-} -result {32}
+} -result 32
test frame-13.44 {labelframe configuration options} -body {
- .f configure -width badValue
+ .f configure -width badValue
} -returnCodes error -result {bad screen distance "badValue"}
destroy .f
-
test frame-14.1 {labelframe labelwidget option} -setup {
deleteWindows
} -body {
@@ -1497,10 +1473,10 @@ test frame-14.5 {labelframe labelwidget option} -setup {
test frame-14.6 {labelframe labelwidget option} -setup {
deleteWindows
} -body {
- # Destroying a labelframe with a child label caused a crash
- # when not handling mapping of the label correctly.
- # This test does not test anything directly, it's just ment
- # to catch if the same mistake is made again.
+ # Destroying a labelframe with a child label caused a crash when not
+ # handling mapping of the label correctly.
+ # This test does not test anything directly, it's just ment to catch if
+ # the same mistake is made again.
labelframe .f
pack .f
label .f.l -text Mupp
@@ -1510,13 +1486,13 @@ test frame-14.6 {labelframe labelwidget option} -setup {
deleteWindows
} -result {}
deleteWindows
-rename eatColors {}
-rename colorsFree {}
+apply {cmds {foreach cmd $cmds {rename $cmd {}}}} {
+ eatColors colorsFree uniq optnames
+}
-# cleanup
cleanupTests
return
-
-
-
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/geometry.test b/tests/geometry.test
index c10a119..d3bb0c5 100644
--- a/tests/geometry.test
+++ b/tests/geometry.test
@@ -282,7 +282,7 @@ test geometry-4.10 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} -setup {
winfo ismapped .t.quit
} -cleanup {
destroy .t
-} -result {1}
+} -result 1
# cleanup
diff --git a/tests/grid.test b/tests/grid.test