diff options
Diffstat (limited to 'tests/ttk/ttk.test')
| -rw-r--r-- | tests/ttk/ttk.test | 199 |
1 files changed, 85 insertions, 114 deletions
diff --git a/tests/ttk/ttk.test b/tests/ttk/ttk.test index a1430ff..9732f46 100644 --- a/tests/ttk/ttk.test +++ b/tests/ttk/ttk.test @@ -28,24 +28,19 @@ test ttk-6.2 "Checkbutton self-destructed" -body { winfo exists .sd } -result 0 -test ttk-6.3 "Test package cleanup" -body { - interp create foo - foo eval { if {[catch {package require Tk}]} { load {} Tk } } - foo eval { destroy . } - interp delete foo -} +# 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} { @@ -66,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 @@ -85,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} @@ -103,10 +94,41 @@ 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 {}] + +test ttk-selfdestruct-ok-1 "Intentional self-destruction" -body { + # see #2298720 + toplevel .t + ttk::button .t.b -command [list destroy .t] + .t.b invoke + list [winfo exists .t] [winfo exists .t.b] +} -result [list 0 0] + # # Basic tests. # - test ttk-1.1 "Create button" -body { pack [ttk::button .t] -expand true -fill both update @@ -116,8 +138,11 @@ test ttk-1.2 "Check style" -body { .t cget -style } -result {} +test ttk-1.3 "Set bad style" -body { + .t configure -style "nosuchstyle" +} -returnCodes 1 -result {Layout nosuchstyle not found} -test ttk-1.4 "Restore default style" -body { +test ttk-1.4 "Original style preserved" -body { .t cget -style } -result "" @@ -172,7 +197,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 @@ -191,6 +215,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] @@ -241,90 +269,6 @@ test ttk-4.4 "Bad resource specifications" -body { } # -# checkbutton tests -# -test ttk-5.1 "Checkbutton check" -body { - pack [ttk::checkbutton .cb -text "TCheckbutton" -variable cb] -} -test ttk-5.2 "Checkbutton invoke" -body { - .cb invoke - list [set ::cb] [.cb instate selected] -} -result [list 1 1] -test ttk-5.3 "Checkbutton reinvoke" -body { - .cb invoke - list [set ::cb] [.cb instate selected] -} -result [list 0 0] - -test ttk-5.4 "Checkbutton variable" -body { - set result [] - set ::cb 1 - lappend result [.cb instate selected] - set ::cb 0 - lappend result [.cb instate selected] -} -result {1 0} - -test ttk-5.5 "Unset checkbutton variable" -body { - set result [] - unset ::cb - lappend result [.cb instate alternate] [info exists ::cb] - set ::cb 1 - lappend result [.cb instate alternate] [info exists ::cb] -} -result {1 0 0 1} - -# See #1257319 -test ttk-5.6 "Checkbutton default variable" -body { - destroy .cb ; unset -nocomplain {} ; set result [list] - ttk::checkbutton .cb -onvalue on -offvalue off - lappend result [.cb cget -variable] [info exists .cb] [.cb state] - .cb invoke - lappend result [info exists .cb] [set .cb] [.cb state] - .cb invoke - lappend result [info exists .cb] [set .cb] [.cb state] -} -result [list .cb 0 alternate 1 on selected 1 off {}] - -# -# radiobutton tests -# -test ttk-7.1 "Radiobutton check" -body { - pack \ - [ttk::radiobutton .rb1 -text "One" -variable choice -value 1] \ - [ttk::radiobutton .rb2 -text "Two" -variable choice -value 2] \ - [ttk::radiobutton .rb3 -text "Three" -variable choice -value 3] \ - ; -} -test ttk-7.2 "Radiobutton invoke" -body { - .rb1 invoke - set ::choice -} -result 1 - -test ttk-7.3 "Radiobutton state" -body { - .rb1 instate selected -} -result 1 - -test ttk-7.4 "Other radiobutton invoke" -body { - .rb2 invoke - set ::choice -} -result 2 - -test ttk-7.5 "Other radiobutton state" -body { - .rb2 instate selected -} -result 1 - -test ttk-7.6 "First radiobutton state" -body { - .rb1 instate selected -} -result 0 - -test ttk-7.7 "Unset radiobutton variable" -body { - unset ::choice - list [info exists ::choice] [.rb1 instate alternate] [.rb2 instate alternate] -} -result {0 1 1} - -test ttk-7.8 "Reset radiobutton variable" -body { - set ::choice 2 - list [info exists ::choice] [.rb1 instate alternate] [.rb2 instate alternate] -} -result {1 0 0} - -# # -compound tests: # variable iconData \ @@ -444,7 +388,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 @@ -554,7 +498,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 @@ -596,16 +539,44 @@ test ttk-14.3 "-textvariable in nonexistant namespace" -body { -match glob -cleanup { destroy .tw } -test ttk-15.1 "style element create: insufficient args" -body { +## Test ensemble processing: +# +# (See also: SF#2021443) +# +proc wrong#args {args} { + return "wrong # args: should be \"$args\"" +} +proc wrong#varargs {varpart args} { + set usage $args + append usage " ?$varpart ...?" + return "wrong # args: should be \"$usage\"" +} + +test ttk-ensemble-0 "style element create: insufficient args" -body { + ttk::style +} -returnCodes 1 -result \ + [wrong#varargs arg ttk::style option] + +test ttk-ensemble-1 "style element create: insufficient args" -body { + ttk::style element +} -returnCodes 1 -result \ + [wrong#varargs arg ttk::style element option] + +test ttk-ensemble-2 "style element create: insufficient args" -body { ttk::style element create -} -returnCodes 1 -result "wrong # args: should be \"ttk::style element create name type ?options...?\"" -test ttk-15.2 "style element create: insufficient args" -body { +} -returnCodes 1 -result \ + [wrong#varargs {-option value} ttk::style element create name type] + +test ttk-ensemble-3 "style element create: insufficient args" -body { ttk::style element create plain.background -} -returnCodes 1 -result "wrong # args: should be \"ttk::style element create name type ?options...?\"" -test ttk-15.3 "style element create: insufficient args" -body { +} -returnCodes 1 -result \ + [wrong#varargs {-option value} ttk::style element create name type] + +test ttk-ensemble-4 "style element create: insufficient args" -body { ttk::style element create plain.background from -} -returnCodes 1 -result "wrong # args: should be \"theme ?element?\"" -test ttk-15.4 "style element create: valid" -body { +} -returnCodes 1 -result [wrong#args theme ?element?] + +test ttk-ensemble-5 "style element create: valid" -body { ttk::style element create plain.background from default } -returnCodes 0 -result "" |