diff options
Diffstat (limited to 'tests/ttk')
| -rw-r--r-- | tests/ttk/ttk.test | 56 |
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 ...?\"" |