1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294
|
#
# ttk::spinbox widget tests
#
package require widgetPlus
namespace import ::widgetPlus::ttkSpinboxPlus
# ------------------------------------------------------------------------------
# This file is copied from ttk/spinbox.test, with addition of the two lines
# above, application of "s/ttk::spinbox/ttkSpinboxPlus/g" to the code (but not
# to comments, results, test names or other metadata).
#
# The purpose is to check that "ttkSpinboxPlus" does not break any features of
# "ttk::spinbox", including important matters such as validation.
#
# All tests pass.
# ------------------------------------------------------------------------------
package require Tk
package require tcltest ; namespace import -force tcltest::*
loadTestedCommands
test spinbox-1.0 "Spinbox tests -- setup" -body {
ttkSpinboxPlus .sb
} -cleanup { destroy .sb } -result .sb
test spinbox-1.1 "Bad -values list" -setup {
ttkSpinboxPlus .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 {
ttkSpinboxPlus .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 {
ttkSpinboxPlus .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 {
ttkSpinboxPlus .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 {
ttkSpinboxPlus .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 {
ttkSpinboxPlus .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 {
ttkSpinboxPlus .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 {
ttkSpinboxPlus .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 {
ttkSpinboxPlus .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 {
ttkSpinboxPlus .sb -from 0 -to 100 -command {set ::spinbox_test 1}
} -body {
set ::spinbox_test 0
.sb set 50
event generate .sb <<Increment>>
set ::spinbox_test
} -cleanup {
destroy .sb
} -result 1
test spinbox-1.8.1 "option -validate" -setup {
ttkSpinboxPlus .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 {
ttkSpinboxPlus .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 {
ttkSpinboxPlus .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 {}
ttkSpinboxPlus .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 {
ttkSpinboxPlus .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 {
ttkSpinboxPlus .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 {
ttkSpinboxPlus .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 {
ttkSpinboxPlus .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 {
ttkSpinboxPlus .sb -values [list c b a d e]
} -body {
.sb current 2
.sb set "z"
.sb current
} -cleanup {
destroy .sb
} -result -1
# 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
ttkSpinboxPlus .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
ttkSpinboxPlus .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
ttkSpinboxPlus .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
ttkSpinboxPlus .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
ttkSpinboxPlus .sb -from 0 -to 59 -format %02.0f -textvariable secs
set result [list $secs]
event generate .sb <<Increment>>; lappend result $secs
event generate .sb <<Increment>>; lappend result $secs
event generate .sb <<Increment>>; lappend result $secs
event generate .sb <<Increment>>; lappend result $secs
event generate .sb <<Decrement>>; lappend result $secs
event generate .sb <<Decrement>>; lappend result $secs
event generate .sb <<Decrement>>; lappend result $secs
event generate .sb <<Decrement>>; 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]
ttkSpinboxPlus .sb -from 0 -to 100 -format %03.0f
.sb set asdfasdf ; lappend result [.sb get]
event generate .sb <<Increment>> ; lappend result [.sb get]
.sb set asdfasdf ; lappend result [.sb get]
event generate .sb <<Decrement>> ; lappend result [.sb get]
} -result [list asdfasdf 000 asdfasdf 000] -cleanup {
destroy .sb
}
tcltest::cleanupTests
# Local variables:
# mode: tcl
# End:
|