blob: 7c888c62875172db90e9d62d9bf1a1f610b23ce0 (
plain)
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
|
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
}
# check existence and default value of each non-core option of the widget
test progressbar-3.1 "progressbar non-core options" -setup {
set res {}
ttk::progressbar .defaultpb
} -body {
foreach option {-anchor -foreground -justify -style -text -wraplength \
-length -maximum -mode -orient -phase -value -variable} {
lappend res [.defaultpb cget $option]
}
set res
} -cleanup {
unset res
destroy .defaultpb
} -result {w black left {} {} 0 100 100 determinate horizontal 0 0.0 {}}
test progressbar-3.2 "TIP #442 options are taken into account" -setup {
set res {}
pack [ttk::progressbar .p -value 0 -maximum 50 -orient horizontal -mode determinate -length 500]
set thefont [font actual {Arial 10}]
} -body {
.p configure -anchor c -foreground blue -justify right \
-text "TIP #442\noptions are now tested" -wraplength 100
update
.p step 10
.p configure -anchor e -font $thefont -foreground green -justify center \
-text "Changing the value of each option\nfrom TIP #442" -wraplength 250
update
.p step 20
.p configure -orient vertical -text "Cannot be seen"
update
foreach option {-anchor -foreground -justify -text -wraplength} {
lappend res [list $option [.p cget $option]]
}
set res
} -cleanup {
unset res thefont
destroy .p
} -result {{-anchor e} {-foreground green} {-justify center} {-text {Cannot be seen}} {-wraplength 250}}
tcltest::cleanupTests
|