1package require tk 2package require tcltest 2.2 3namespace import -force tcltest::* 4loadTestedCommands 5 6 7test progressbar-1.1 "Setup" -body { 8 ttk::progressbar .pb 9} -result .pb 10 11test progressbar-1.2 "Linked variable" -body { 12 set PB 50 13 .pb configure -variable PB 14 .pb cget -value 15} -result 50 16 17test progressbar-1.3 "Change linked variable" -body { 18 set PB 80 19 .pb cget -value 20} -result 80 21 22test progressbar-1.4 "Set linked variable to bad value" -body { 23 set PB "bogus" 24 .pb instate invalid 25} -result 1 26 27test progressbar-1.4.1 "Set linked variable back to a good value" -body { 28 set PB 80 29 .pb instate invalid 30} -result 0 31 32test progressbar-1.5 "Set -variable to illegal variable" -body { 33 set BAD "bogus" 34 .pb configure -variable BAD 35 .pb instate invalid 36} -result 1 37 38test progressbar-1.6 "Unset -variable" -body { 39 unset -nocomplain UNSET 40 .pb configure -variable UNSET 41 .pb instate disabled 42} -result 1 43 44test progressbar-2.0 "step command" -body { 45 .pb configure -variable {} ;# @@@ 46 .pb configure -value 5 -maximum 10 -mode determinate 47 .pb step 48 .pb cget -value 49} -result 6.0 50 51test progressbar-2.1 "step command, with stepamount" -body { 52 .pb step 3 53 .pb cget -value 54} -result 9.0 55 56test progressbar-2.2 "step wraps at -maximum in determinate mode" -body { 57 .pb step 58 .pb cget -value 59} -result 0.0 60 61test progressbar-2.3 "step doesn't wrap in indeterminate mode" -body { 62 .pb configure -value 8 -maximum 10 -mode indeterminate 63 .pb step 64 .pb step 65 .pb step 66 .pb cget -value 67} -result 11.0 68 69test progressbar-2.4 "step with linked variable" -body { 70 .pb configure -variable PB ;# @@@ 71 set PB 5 72 .pb step 73 set PB 74} -result 6.0 75 76test progressbar-2.5 "error in write trace" -body { 77 trace variable PB w { error "YIPES!" ;# } 78 .pb step 79 set PB ;# NOTREACHED 80} -cleanup { unset PB } -returnCodes error -match glob -result "*YIPES!" 81 82test progressbar-end "Cleanup" -body { 83 destroy .pb 84} 85 86# check existence and default value of each non-core option of the widget 87test progressbar-3.1 "progressbar non-core options" -setup { 88 set res {} 89 ttk::progressbar .defaultpb 90} -body { 91 foreach option {-anchor -foreground -justify -style -text -wraplength \ 92 -length -maximum -mode -orient -phase -value -variable} { 93 lappend res [.defaultpb cget $option] 94 } 95 set res 96} -cleanup { 97 unset res 98 destroy .defaultpb 99} -result {w black left {} {} 0 100 100 determinate horizontal 0 0.0 {}} 100 101test progressbar-3.2 "TIP #442 options are taken into account" -setup { 102 set res {} 103 pack [ttk::progressbar .p -value 0 -maximum 50 -orient horizontal -mode determinate -length 500] 104 set thefont [font actual {Arial 10}] 105} -body { 106 .p configure -anchor c -foreground blue -justify right \ 107 -text "TIP #442\noptions are now tested" -wraplength 100 108 update 109 .p step 10 110 .p configure -anchor e -font $thefont -foreground green -justify center \ 111 -text "Changing the value of each option\nfrom TIP #442" -wraplength 250 112 update 113 .p step 20 114 .p configure -orient vertical -text "Cannot be seen" 115 update 116 foreach option {-anchor -foreground -justify -text -wraplength} { 117 lappend res [list $option [.p cget $option]] 118 } 119 set res 120} -cleanup { 121 unset res thefont 122 destroy .p 123} -result {{-anchor e} {-foreground green} {-justify center} {-text {Cannot be seen}} {-wraplength 250}} 124 125test progressbar-4.1 "style command" -body { 126 ttk::progressbar .wh ; # default is -orient horizontal 127 ttk::progressbar .wv -orient vertical 128 list [.wh cget -style] [.wh style] [winfo class .wh]\ 129 [.wv cget -style] [.wv style] [winfo class .wv] 130} -cleanup { 131 destroy .wh .wv 132} -result {{} Horizontal.TProgressbar TProgressbar {} Vertical.TProgressbar TProgressbar} 133test progressbar-4.2 "style command" -body { 134 ttk::style configure customStyle.Vertical.TProgressbar 135 ttk::progressbar .w -orient vertical -style customStyle.Vertical.TProgressbar 136 list [.w cget -style] [.w style] [winfo class .w] 137} -cleanup { 138 destroy .w 139} -result {customStyle.Vertical.TProgressbar Vertical.customStyle.Vertical.TProgressbar TProgressbar} 140 141tcltest::cleanupTests 142