1# 2# ttk::spinbox widget tests 3# 4 5package require Tk 6package require tcltest ; namespace import -force tcltest::* 7loadTestedCommands 8 9test spinbox-1.0 "Spinbox tests -- setup" -body { 10 ttk::spinbox .sb 11} -cleanup { destroy .sb } -result .sb 12 13test spinbox-1.1 "Bad -values list" -setup { 14 ttk::spinbox .sb 15} -body { 16 .sb configure -values "bad \{list" 17} -cleanup { 18 destroy .sb 19} -returnCodes error -result "unmatched open brace in list" 20 21test spinbox-1.3.1 "get retrieves value" -setup { 22 ttk::spinbox .sb -from 0 -to 100 23} -body { 24 .sb set 50 25 .sb get 26} -cleanup { 27 destroy .sb 28} -result 50 29 30test spinbox-1.3.2 "get retrieves value" -setup { 31 ttk::spinbox .sb -from 0 -to 100 -values 55 32} -body { 33 .sb set 55 34 .sb get 35} -cleanup { 36 destroy .sb 37} -result 55 38 39test spinbox-1.4.1 "set changes value" -setup { 40 ttk::spinbox .sb -from 0 -to 100 41} -body { 42 .sb set 33 43 .sb get 44} -cleanup { 45 destroy .sb 46} -result 33 47 48test spinbox-1.4.2 "set changes value" -setup { 49 ttk::spinbox .sb -from 0 -to 100 -values 55 50} -body { 51 .sb set 33 52 .sb get 53} -cleanup { 54 destroy .sb 55} -result 33 56 57 58test spinbox-1.6.1 "insert start" -setup { 59 ttk::spinbox .sb -from 0 -to 100 60} -body { 61 .sb set 5 62 .sb insert 0 4 63 .sb get 64} -cleanup { 65 destroy .sb 66} -result 45 67 68test spinbox-1.6.2 "insert end" -setup { 69 ttk::spinbox .sb -from 0 -to 100 70} -body { 71 .sb set 5 72 .sb insert end 4 73 .sb get 74} -cleanup { 75 destroy .sb 76} -result 54 77 78test spinbox-1.6.3 "insert invalid index" -setup { 79 ttk::spinbox .sb -from 0 -to 100 80} -body { 81 .sb set 5 82 .sb insert 100 4 83 .sb get 84} -cleanup { 85 destroy .sb 86} -result 54 87 88test spinbox-1.7.1 "-command option: set doesnt fire" -setup { 89 ttk::spinbox .sb -from 0 -to 100 -command {set ::spinbox_test 1} 90} -body { 91 set ::spinbox_test 0 92 .sb set 50 93 set ::spinbox_test 94} -cleanup { 95 destroy .sb 96} -result 0 97 98test spinbox-1.7.2 "-command option: button handler will fire" -setup { 99 ttk::spinbox .sb -from 0 -to 100 -command {set ::spinbox_test 1} 100} -body { 101 set ::spinbox_test 0 102 .sb set 50 103 event generate .sb <<Increment>> 104 set ::spinbox_test 105} -cleanup { 106 destroy .sb 107} -result 1 108 109test spinbox-1.8.1 "option -validate" -setup { 110 ttk::spinbox .sb -from 0 -to 100 111} -body { 112 .sb configure -validate all 113 .sb cget -validate 114} -cleanup { 115 destroy .sb 116} -result {all} 117 118test spinbox-1.8.2 "option -validate" -setup { 119 ttk::spinbox .sb -from 0 -to 100 120} -body { 121 .sb configure -validate key 122 .sb configure -validate focus 123 .sb configure -validate focusin 124 .sb configure -validate focusout 125 .sb configure -validate none 126 .sb cget -validate 127} -cleanup { 128 destroy .sb 129} -result {none} 130 131test spinbox-1.8.3 "option -validate" -setup { 132 ttk::spinbox .sb -from 0 -to 100 133} -body { 134 .sb configure -validate bogus 135} -cleanup { 136 destroy .sb 137} -returnCodes error -result {bad validate "bogus": must be all, key, focus, focusin, focusout, or none} 138 139test spinbox-1.8.4 "-validate option: " -setup { 140 set ::spinbox_test {} 141 ttk::spinbox .sb -from 0 -to 100 142} -body { 143 .sb configure -validate all -validatecommand {lappend ::spinbox_test %P} 144 pack .sb 145 .sb set 50 146 focus -force .sb 147 after 500 {set ::spinbox_wait 1} ; vwait ::spinbox_wait 148 set ::spinbox_test 149} -cleanup { 150 destroy .sb 151} -result {50} 152 153 154test spinbox-2.0 "current command -- unset should be 0" -constraints nyi -setup { 155 ttk::spinbox .sb -values [list a b c d e a] 156} -body { 157 .sb current 158} -cleanup { 159 destroy .sb 160} -result 0 161# @@@ for combobox, this is -1. 162 163test spinbox-2.1 "current command -- set index" -constraints nyi -setup { 164 ttk::spinbox .sb -values [list a b c d e a] 165} -body { 166 .sb current 5 167 .sb get 168} -cleanup { 169 destroy .sb 170} -result a 171 172test spinbox-2.2 "current command -- change -values" -constraints nyi -setup { 173 ttk::spinbox .sb -values [list a b c d e a] 174} -body { 175 .sb current 5 176 .sb configure -values [list c b a d e] 177 .sb current 178} -cleanup { 179 destroy .sb 180} -result 2 181 182test spinbox-2.3 "current command -- change value" -constraints nyi -setup { 183 ttk::spinbox .sb -values [list c b a d e] 184} -body { 185 .sb current 2 186 .sb set "b" 187 .sb current 188} -cleanup { 189 destroy .sb 190} -result 1 191 192test spinbox-2.4 "current command -- value not in list" -constraints nyi -setup { 193 ttk::spinbox .sb -values [list c b a d e] 194} -body { 195 .sb current 2 196 .sb set "z" 197 .sb current 198} -cleanup { 199 destroy .sb 200} -result -1 201 202# nostomp: NB intentional difference between ttk::spinbox and tk::spinbox; 203# see also #1439266 204# 205test spinbox-nostomp-1 "don't stomp on -variable (init; -from/to)" -body { 206 set SBV 55 207 ttk::spinbox .sb -textvariable SBV -from 0 -to 100 -increment 5 208 list $SBV [.sb get] 209} -cleanup { 210 unset SBV 211 destroy .sb 212} -result [list 55 55] 213 214test spinbox-nostomp-2 "don't stomp on -variable (init; -values)" -body { 215 set SBV Apr 216 ttk::spinbox .sb -textvariable SBV -values {Jan Feb Mar Apr May Jun Jul Aug} 217 list $SBV [.sb get] 218} -cleanup { 219 unset SBV 220 destroy .sb 221} -result [list Apr Apr] 222 223test spinbox-nostomp-3 "don't stomp on -variable (configure; -from/to)" -body { 224 set SBV 55 225 ttk::spinbox .sb 226 .sb configure -textvariable SBV -from 0 -to 100 -increment 5 227 list $SBV [.sb get] 228} -cleanup { 229 unset SBV 230 destroy .sb 231} -result [list 55 55] 232 233test spinbox-nostomp-4 "don't stomp on -variable (configure; -values)" -body { 234 set SBV Apr 235 ttk::spinbox .sb 236 .sb configure -textvariable SBV -values {Jan Feb Mar Apr May Jun Jul Aug} 237 list $SBV [.sb get] 238} -cleanup { 239 unset SBV 240 destroy .sb 241} -result [list Apr Apr] 242 243test spinbox-dieoctaldie-1 "Cope with leading zeros" -body { 244 # See SF#2358545 -- ttk::spinbox also affected 245 set secs 07 246 ttk::spinbox .sb -from 0 -to 59 -format %02.0f -textvariable secs 247 248 set result [list $secs] 249 event generate .sb <<Increment>>; lappend result $secs 250 event generate .sb <<Increment>>; lappend result $secs 251 event generate .sb <<Increment>>; lappend result $secs 252 event generate .sb <<Increment>>; lappend result $secs 253 254 event generate .sb <<Decrement>>; lappend result $secs 255 event generate .sb <<Decrement>>; lappend result $secs 256 event generate .sb <<Decrement>>; lappend result $secs 257 event generate .sb <<Decrement>>; lappend result $secs 258 259 set result 260} -result [list 07 08 09 10 11 10 09 08 07] -cleanup { 261 destroy .sb 262 unset secs 263} 264 265test spinbox-dieoctaldie-2 "Cope with general bad input" -body { 266 set result [list] 267 ttk::spinbox .sb -from 0 -to 100 -format %03.0f 268 .sb set asdfasdf ; lappend result [.sb get] 269 event generate .sb <<Increment>> ; lappend result [.sb get] 270 .sb set asdfasdf ; lappend result [.sb get] 271 event generate .sb <<Decrement>> ; lappend result [.sb get] 272} -result [list asdfasdf 000 asdfasdf 000] -cleanup { 273 destroy .sb 274} 275 276tcltest::cleanupTests 277 278# Local variables: 279# mode: tcl 280# End: 281