summaryrefslogtreecommitdiffstats
path: root/tests/ttk/ttk.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/ttk/ttk.test')
-rw-r--r--tests/ttk/ttk.test56
1 files changed, 38 insertions, 18 deletions
diff --git a/tests/ttk/ttk.test b/tests/ttk/ttk.test
index 4092c40..e050e2a 100644
--- a/tests/ttk/ttk.test
+++ b/tests/ttk/ttk.test
@@ -23,24 +23,24 @@ test ttk-6.1 "Self-destructing checkbutton" -body {
trace variable sd w [list selfdestruct .sd]
update
.sd invoke
-} -returnCodes 1
+} -returnCodes 1 -result "Widget has been destroyed"
test ttk-6.2 "Checkbutton self-destructed" -body {
winfo exists .sd
} -result 0
# test ttk-6.3 not applicable [see #2175411]
-test ttk-6.4 "Defeat evil intentions" -body {
+test ttk-6.4 "Destroy widget in configure" -setup {
+ set OUCH ouch
trace variable OUCH r { kill.b }
proc kill.b {args} { destroy .b }
+} -cleanup {
+ unset OUCH
+} -body {
pack [ttk::checkbutton .b]
- .b configure -variable OUCH
- # At this point, .b should be gone.
- .b invoke
- list [set OUCH] [winfo exists .b]
- # Mostly we just care that we haven't crashed the interpreter.
- #
-} -returnCodes error -match glob -result "*"
+ set rc [catch { .b configure -variable OUCH } msg]
+ list $rc $msg [winfo exists .b] [info commands .b]
+} -result [list 1 "Widget has been destroyed" 0 {}]
test ttk-6.5 "Clean up -textvariable traces" -body {
foreach class {ttk::button ttk::checkbutton ttk::radiobutton} {
@@ -61,7 +61,6 @@ test ttk-6.6 "Bad color spec in styles" -body {
set ::bgerror
} -result {unknown color name "badColor"}
-# This should move to be a standard test per widget test file
test ttk-6.7 "Basic destruction test" -body {
foreach widget {
button checkbutton radiobutton sizegrip separator notebook
@@ -80,9 +79,6 @@ test ttk-6.8 "Button command removes itself" -body {
set ::A
} -result {it worked}
-#
-#
-
test ttk-6.9 "Bad font spec in styles" -setup {
ttk::style theme create badfont -settings {
ttk::style configure . -font {Helvetica 12 Bogus}
@@ -98,6 +94,30 @@ test ttk-6.9 "Bad font spec in styles" -setup {
set ::bgerror
} -result {unknown font style "Bogus"}
+test ttk-construction-failure-1 "Excercise construction failure path" -setup {
+ option add *TLabel.cursor badCursor 1
+} -cleanup {
+ option add *TLabel.cursor {} 1
+} -body {
+ catch {ttk::label .l} errmsg
+ list $errmsg [info commands .l] [winfo exists .l]
+} -result [list {bad cursor spec "badCursor"} {} 0]
+
+test ttk-construction-failure-2 "Destroy widget in constructor" -setup {
+ set OUCH ouch
+ trace variable OUCH r { kill.b }
+ proc kill.b {args} { destroy .b }
+} -cleanup {
+ unset OUCH
+} -body {
+ list \
+ [catch { ttk::checkbutton .b -variable OUCH } msg] \
+ $msg \
+ [winfo exists .b] \
+ [info commands .b] \
+ ;
+} -result [list 1 "Widget has been destroyed" 0 {}]
+
#
# Basic tests.
#
@@ -111,7 +131,6 @@ test ttk-1.2 "Check style" -body {
.t cget -style
} -result {}
-
test ttk-1.4 "Restore default style" -body {
.t cget -style
} -result ""
@@ -167,7 +186,6 @@ test ttk-2.7 "instate scripts, true" -body {
set x
} -result 1
-
# misc. error detection
test ttk-3.0 "Bad option" -body {
ttk::button .bad -badoption foo
@@ -186,6 +204,10 @@ test ttk-3.2 "Propagate errors from variable traces" -body {
unset ::A ; destroy .cb
} -returnCodes error -result {can't set "A": failure}
+test ttk-3.3 "Constructor failure with cursor" -body {
+ ttk::button .b -cursor bottom_right_corner -style BadStyle
+} -returnCodes 1 -result "Layout BadStyle not found"
+
test ttk-3.4 "SF#2009213" -body {
ttk::style configure TScale -sliderrelief {}
pack [ttk::scale .s]
@@ -439,7 +461,7 @@ test ttk-9.6 "Unset -textvariable" -body {
test ttk-9.7 "Unset textvariable, comparison" -body {
#
-# NB: the ttk label behaves differently from the standard label here;
+# NB: ttk::label behaves differently from the standard label here;
# NB: this is on purpose: I believe the standard behaviour is the Wrong Thing
#
unset -nocomplain V1 V2
@@ -549,7 +571,6 @@ test ttk-12.4 "-borderwidth frame option" -body {
update
}
-
test ttk-13.1 "Custom styles -- bad -style option" -body {
ttk::button .tb1 -style badstyle
} -returnCodes 1 -result "*badstyle not found*" -match glob
@@ -590,7 +611,6 @@ test ttk-14.3 "-textvariable in nonexistant namespace" -body {
} -returnCodes 1 -result {can't trace *: parent namespace doesn't exist} \
-match glob -cleanup { destroy .tw }
-
test ttk-15.1 "style element create: insufficient args" -body {
ttk::style element create
} -returnCodes 1 -result "wrong # args: should be \"ttk::style element create name type ?-option value ...?\""