# # ttk::spinbox widget tests # package require Tk package require tcltest ; namespace import -force tcltest::* loadTestedCommands test spinbox-1.0 "Spinbox tests -- setup" -body { ttk::spinbox .sb } -cleanup { destroy .sb } -result .sb test spinbox-1.1 "Bad -values list" -setup { ttk::spinbox .sb } -body { .sb configure -values "bad \{list" } -cleanup { destroy .sb } -returnCodes error -result "unmatched open brace in list" test spinbox-1.3.1 "get retrieves value" -setup { ttk::spinbox .sb -from 0 -to 100 } -body { .sb set 50 .sb get } -cleanup { destroy .sb } -result 50 test spinbox-1.3.2 "get retrieves value" -setup { ttk::spinbox .sb -from 0 -to 100 -values 55 } -body { .sb set 55 .sb get } -cleanup { destroy .sb } -result 55 test spinbox-1.4.1 "set changes value" -setup { ttk::spinbox .sb -from 0 -to 100 } -body { .sb set 33 .sb get } -cleanup { destroy .sb } -result 33 test spinbox-1.4.2 "set changes value" -setup { ttk::spinbox .sb -from 0 -to 100 -values 55 } -body { .sb set 33 .sb get } -cleanup { destroy .sb } -result 33 test spinbox-1.6.1 "insert start" -setup { ttk::spinbox .sb -from 0 -to 100 } -body { .sb set 5 .sb insert 0 4 .sb get } -cleanup { destroy .sb } -result 45 test spinbox-1.6.2 "insert end" -setup { ttk::spinbox .sb -from 0 -to 100 } -body { .sb set 5 .sb insert end 4 .sb get } -cleanup { destroy .sb } -result 54 test spinbox-1.6.3 "insert invalid index" -setup { ttk::spinbox .sb -from 0 -to 100 } -body { .sb set 5 .sb insert 100 4 .sb get } -cleanup { destroy .sb } -result 54 test spinbox-1.7.1 "-command option: set doesnt fire" -setup { ttk::spinbox .sb -from 0 -to 100 -command {set ::spinbox_test 1} } -body { set ::spinbox_test 0 .sb set 50 set ::spinbox_test } -cleanup { destroy .sb } -result 0 test spinbox-1.7.2 "-command option: button handler will fire" -setup { ttk::spinbox .sb -from 0 -to 100 -command {set ::spinbox_test 1} } -body { set ::spinbox_test 0 .sb set 50 event generate .sb <> set ::spinbox_test } -cleanup { destroy .sb } -result 1 test spinbox-1.8.1 "option -validate" -setup { ttk::spinbox .sb -from 0 -to 100 } -body { .sb configure -validate all .sb cget -validate } -cleanup { destroy .sb } -result {all} test spinbox-1.8.2 "option -validate" -setup { ttk::spinbox .sb -from 0 -to 100 } -body { .sb configure -validate key .sb configure -validate focus .sb configure -validate focusin .sb configure -validate focusout .sb configure -validate none .sb cget -validate } -cleanup { destroy .sb } -result {none} test spinbox-1.8.3 "option -validate" -setup { ttk::spinbox .sb -from 0 -to 100 } -body { .sb configure -validate bogus } -cleanup { destroy .sb } -returnCodes error -result {bad validate "bogus": must be all, key, focus, focusin, focusout, or none} test spinbox-1.8.4 "-validate option: " -setup { set ::spinbox_test {} ttk::spinbox .sb -from 0 -to 100 } -body { .sb configure -validate all -validatecommand {lappend ::spinbox_test %P} pack .sb .sb set 50 focus -force .sb after 500 {set ::spinbox_wait 1} ; vwait ::spinbox_wait set ::spinbox_test } -cleanup { destroy .sb } -result {50} test spinbox-2.0 "current command -- unset should be 0" -constraints nyi -setup { ttk::spinbox .sb -values [list a b c d e a] } -body { .sb current } -cleanup { destroy .sb } -result 0 # @@@ for combobox, this is -1. test spinbox-2.1 "current command -- set index" -constraints nyi -setup { ttk::spinbox .sb -values [list a b c d e a] } -body { .sb current 5 .sb get } -cleanup { destroy .sb } -result a test spinbox-2.2 "current command -- change -values" -constraints nyi -setup { ttk::spinbox .sb -values [list a b c d e a] } -body { .sb current 5 .sb configure -values [list c b a d e] .sb current } -cleanup { destroy .sb } -result 2 test spinbox-2.3 "current command -- change value" -constraints nyi -setup { ttk::spinbox .sb -values [list c b a d e] } -body { .sb current 2 .sb set "b" .sb current } -cleanup { destroy .sb } -result 1 test spinbox-2.4 "current command -- value not in list" -constraints nyi -setup { ttk::spinbox .sb -values [list c b a d e] } -body { .sb current 2 .sb set "z" .sb current } -cleanup { destroy .sb } -result -1 test spinbox-3.0 "textarea should expand to fill widget" -setup { set SBV 5 set ::spinbox_test {} ttk::spinbox .sb -from 0 -to 10 -textvariable SBV } -body { grid .sb -sticky ew grid columnconfigure . 0 -weight 1 bind . { after idle { wm geometry . "210x80" after 100 {set ::spinbox_test [.sb identify element 5 5]} } bind . {} } after 500 {set ::spinbox_wait 1} ; vwait ::spinbox_wait set ::spinbox_test } -cleanup { destroy .sb unset -nocomplain ::spinbox_test SBV } -result {textarea} # nostomp: NB intentional difference between ttk::spinbox and tk::spinbox; # see also #1439266 # test spinbox-nostomp-1 "don't stomp on -variable (init; -from/to)" -body { set SBV 55 ttk::spinbox .sb -textvariable SBV -from 0 -to 100 -increment 5 list $SBV [.sb get] } -cleanup { unset SBV destroy .sb } -result [list 55 55] test spinbox-nostomp-2 "don't stomp on -variable (init; -values)" -body { set SBV Apr ttk::spinbox .sb -textvariable SBV -values {Jan Feb Mar Apr May Jun Jul Aug} list $SBV [.sb get] } -cleanup { unset SBV destroy .sb } -result [list Apr Apr] test spinbox-nostomp-3 "don't stomp on -variable (configure; -from/to)" -body { set SBV 55 ttk::spinbox .sb .sb configure -textvariable SBV -from 0 -to 100 -increment 5 list $SBV [.sb get] } -cleanup { unset SBV destroy .sb } -result [list 55 55] test spinbox-nostomp-4 "don't stomp on -variable (configure; -values)" -body { set SBV Apr ttk::spinbox .sb .sb configure -textvariable SBV -values {Jan Feb Mar Apr May Jun Jul Aug} list $SBV [.sb get] } -cleanup { unset SBV destroy .sb } -result [list Apr Apr] test spinbox-dieoctaldie-1 "Cope with leading zeros" -body { # See SF#2358545 -- ttk::spinbox also affected set secs 07 ttk::spinbox .sb -from 0 -to 59 -format %02.0f -textvariable secs set result [list $secs] event generate .sb <>; lappend result $secs event generate .sb <>; lappend result $secs event generate .sb <>; lappend result $secs event generate .sb <>; lappend result $secs event generate .sb <>; lappend result $secs event generate .sb <>; lappend result $secs event generate .sb <>; lappend result $secs event generate .sb <>; lappend result $secs set result } -result [list 07 08 09 10 11 10 09 08 07] -cleanup { destroy .sb unset secs } test spinbox-dieoctaldie-2 "Cope with general bad input" -body { set result [list] ttk::spinbox .sb -from 0 -to 100 -format %03.0f .sb set asdfasdf ; lappend result [.sb get] event generate .sb <> ; lappend result [.sb get] .sb set asdfasdf ; lappend result [.sb get] event generate .sb <> ; lappend result [.sb get] } -result [list asdfasdf 000 asdfasdf 000] -cleanup { destroy .sb } tcltest::cleanupTests # Local variables: # mode: tcl # End: