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