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
|
package require Tk 8.5
package require tcltest ; namespace import -force tcltest::*
loadTestedCommands
test progressbar-1.1 "Setup" -body {
ttk::progressbar .pb
} -result .pb
test progressbar-1.2 "Linked variable" -body {
set PB 50
.pb configure -variable PB
.pb cget -value
} -result 50
test progressbar-1.3 "Change linked variable" -body {
set PB 80
.pb cget -value
} -result 80
test progressbar-1.4 "Set linked variable to bad value" -body {
set PB "bogus"
.pb instate invalid
} -result 1
test progressbar-1.4.1 "Set linked variable back to a good value" -body {
set PB 80
.pb instate invalid
} -result 0
test progressbar-1.5 "Set -variable to illegal variable" -body {
set BAD "bogus"
.pb configure -variable BAD
.pb instate invalid
} -result 1
test progressbar-1.6 "Unset -variable" -body {
unset -nocomplain UNSET
.pb configure -variable UNSET
.pb instate disabled
} -result 1
test progressbar-2.0 "step command" -body {
.pb configure -variable {} ;# @@@
.pb configure -value 5 -maximum 10 -mode determinate
.pb step
.pb cget -value
} -result 6.0
test progressbar-2.1 "step command, with stepamount" -body {
.pb step 3
.pb cget -value
} -result 9.0
test progressbar-2.2 "step wraps at -maximum in determinate mode" -body {
.pb step
.pb cget -value
} -result 0.0
test progressbar-2.3 "step doesn't wrap in indeterminate mode" -body {
.pb configure -value 8 -maximum 10 -mode indeterminate
.pb step
.pb step
.pb step
.pb cget -value
} -result 11.0
test progressbar-2.4 "step with linked variable" -body {
.pb configure -variable PB ;# @@@
set PB 5
.pb step
set PB
} -result 6.0
test progressbar-2.5 "error in write trace" -body {
trace variable PB w { error "YIPES!" ;# }
.pb step
set PB ;# NOTREACHED
} -cleanup { unset PB } -returnCodes 1 -match glob -result "*YIPES!"
test progressbar-end "Cleanup" -body {
destroy .pb
}
tcltest::cleanupTests
|
