1# This file is a Tcl script to test out [incr Widgets] Toolbar class. 2# It is organized in the standard fashion for Tcl tests with the following 3# notation for test case labels: 4# 5# 1.x - Construction/Destruction tests 6# 2.x - Configuration option tests 7# 3.x - Method tests 8# 9# Copyright (c) 1995 DSC Technologies Corporation 10# 11# See the file "license.terms" for information on usage and redistribution 12# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 13# 14# @(#) $Id: toolbar.test,v 1.4 2001/08/07 19:56:48 smithc Exp $ 15 16package require tcltest 17namespace import -force ::tcltest::* 18 19if [catch {package require Iwidgets 4.0}] { 20 # Let's try modifying the auto_path. Note that the IWIDGETS_LIBRARY 21 # env var is initialized in the Makefile when doing a 'make test'. 22 # If sourcing this file independently, this variable must be set manually. 23 if ![info exists env(IWIDGETS_LIBRARY)] { 24 error "Unable to locate Iwidgets package. Set your IWIDGETS_LIBRARY\ 25 environment\nvariable to the directory that contains iwidgets.tcl" 26 } 27 lappend auto_path $env(IWIDGETS_LIBRARY) 28 package require Iwidgets 4.0 29} 30 31if {[string compare test [info procs test]] == 1} { 32 source defs 33} 34 35wm geometry . {} 36raise . 37 38set c 1 39set o 1 40set m 1 41 42# 43# Initial construction test 44# 45test Toolbar-1.$c {Toolbar construction} { 46 iwidgets::Toolbar .tb 47 pack .tb 48 update 49 .tb add button item1 -text item1 50 update 51 .tb add button item2 -text item2 52 update 53 .tb add button item3 -text item3 54 update 55} {} 56 57incr c 58 59# 60# Option tests which are successful. 61# 62test Toolbar-2.$o {configuration option} { 63 llength [.tb configure] 64} {27} 65 66incr o 67 68foreach test { 69 {-disabledforeground #a3a3a3 #a3a3a3 } 70 {-highlightthickness 0 0 } 71 {-selectborderwidth 4 4 } 72 {-balloonfont 6x10 6x10 } 73 {-balloondelay1 1000 1000 } 74 {-balloondelay2 200 200 } 75 {-borderwidth 2 2 } 76 {-selectcolor #CDCDB7B7B5B5 #CDCDB7B7B5B5 } 77 {-highlightcolor Black Black } 78 {-font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* } 79 {-balloonbackground yellow yellow } 80 {-helpvariable testing testing} 81 {-troughcolor #c3c3c3 #c3c3c3 } 82 {-selectbackground #c3c3c3 #c3c3c3 } 83 {-highlightbackground #d9d9d9 #d9d9d9 } 84 {-background #CDCDB7B7B5B5 #CDCDB7B7B5B5 } 85 {-state normal normal } 86 {-balloonforeground black black } 87 {-selectforeground Black Black } 88 {-foreground #000000000000 #000000000000 } 89 {-activebackground #ececec #ececec } 90 {-insertbackground Black Black } 91 {-cursor crosshair crosshair } 92 {-activeforeground Black Black } 93 {-insertforeground Black Black } 94 {-orient horizontal horizontal } 95 } { 96 set option [lindex $test 0] 97 test Toolbar-2.$o "configuration options, $option" { 98 .tb configure $option [lindex $test 1] 99 .tb cget $option 100 } [lindex $test 2] 101 update 102 incr o 103} 104 105# 106# Itemconfigure Option tests which are successful. 107# 108# This happens to be for a button. Note that the configuration options for 109# the Tk button changed in 8.4. Four new options were added. 110set newoptions [list -compound -overrelief -repeatdelay -repeatinterval] 111set o 0 112if {$::tk_version < 8.4} { 113 test Toolbar-3.$o {tab configuration option} { 114 llength [.tb itemconfigure 0] 115 } {33} 116} else { 117 test Toolbar-3.$o {tab configuration option} { 118 llength [.tb itemconfigure 0] 119 } {37} 120} 121 122# do itemconfigure tests also... 123foreach test { 124 {0 -activebackground #ececec #ececec } 125 {0 -activeforeground Black Black } 126 {0 -anchor center center } 127 {0 -background #d9d9d9 #d9d9d9 } 128 {0 -bd 0 0 } 129 {0 -bg #d9d9d9 #d9d9d9 } 130 {0 -bitmap {} {} } 131 {0 -borderwidth 2 2 } 132 {0 -command {} {} } 133 {0 -compound none none } 134 {0 -cursor {} {} } 135 {0 -default disabled disabled } 136 {0 -disabledforeground #a3a3a3 #a3a3a3 } 137 {0 -fg Black Black } 138 {0 -font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* } 139 {0 -foreground Black Black } 140 {0 -height 0 0 } 141 {0 -highlightbackground #d9d9d9 #d9d9d9 } 142 {0 -highlightcolor Black Black } 143 {0 -highlightthickness 2 2 } 144 {0 -image {} {} } 145 {0 -justify center center } 146 {0 -overrelief {} {} } 147 {0 -padx 4 4 } 148 {0 -pady 4 4 } 149 {0 -relief raised raised } 150 {0 -repeatdelay 0 0 } 151 {0 -repeatinterval 0 0 } 152 {0 -state normal normal } 153 {0 -takefocus false false } 154 {0 -text {} {} } 155 {0 -textvariable {} {} } 156 {0 -underline -1 -1 } 157 {0 -width 0 0 } 158 {0 -wraplength 0 0 } 159 {0 -helpstr {} {} } 160 {0 -balloonstr {} {} } 161 } { 162 set option [lindex $test 1] 163 if {$::tk_version < 8.4} { 164 if {[lsearch $newoptions $option] != -1} { 165 # Skip it. 166 continue 167 } 168 } 169 set index [lindex $test 0] 170 test Toolbar-2.$o "tab configuration options, $option" { 171 .tb itemconfigure $index $option [lindex $test 2] 172 .tb itemcget $index $option 173 } [lindex $test 3] 174 update 175 incr o 176} 177 178 179# 180# Method tests which are successful. 181# 182foreach test { 183 {{.tb delete 0 end} 184 {}} 185 {{.tb add radiobutton one} 186 {.tb.one}} 187 {{.tb index end} 188 {0}} 189 {{.tb add checkbutton two} 190 {.tb.two}} 191 {{.tb index end} 192 {1}} 193 {{.tb index one} 194 {0}} 195 {{.tb insert end button oneandhalf -text "One & half"} 196 {.tb.oneandhalf}} 197 {{.tb index oneandhalf} 198 {1}} 199 {{.tb delete oneandhalf} 200 {}} 201 {{.tb index two} 202 {1}} 203 {{.tb delete 0 end} 204 {}} 205 {{.tb index 0} 206 {-1}} 207 } { 208 set method [lindex [lindex $test 0] 1] 209 set method_invoke [lindex $test 0] 210 211 set testContents "set msg {}\n" 212 append testContents \ 213 "set result \[catch \{[lindex $test 0]\} msg\]\n" 214 append testContents \ 215 "lappend result \[regexp -- \{[lindex $test 1]\} \$msg\] \n" 216 append testContents "set result\n" 217 test Toolbar-4.$m "\[$method_invoke\]" $testContents \ 218 [list 0 1] 219 update 220 incr m 221} 222 223# 224# Method tests which fail and produce errors 225# 226foreach test { 227 {1 {.tb delete 0 end} {}} 228 {0 {.tb add button item1} {}} 229 {0 {.tb delete 0} {}} 230 {1 {.tb delete 0} {can't delete widget, no widgets in the Toolbar}} 231 {0 {.tb add button item1} {}} 232 {1 {.tb delete 1} {bad Toolbar widget index in delete method}} 233 {0 {.tb delete 0} {}} 234 {0 {.tb add button item1} {}} 235 {1 {.tb delete 0 1} {bad Toolbar widget index2 in delete method}} 236 {1 {.tb delete 1 4} {bad Toolbar widget index1 in delete method}} 237 {0 {.tb add button item2} {}} 238 {1 {.tb delete 1 0} {bad Toolbar widget index1 in delete method}} 239 {0 {.tb delete 0 1} {}} 240 {0 {.tb add button item1} {}} 241 {1 {.tb delete 0 1 4 5 6} {wrong # args}} 242 {1 {.tb delete} {wrong # args}} 243 {0 {.tb delete 0} {}} 244 {1 {.tb delete 0} {can't delete widget, no widgets in the Toolbar}} 245 {1 {.tb insert 0 button itemA} {}} 246 {0 {.tb add button item1} {}} 247 {0 {.tb add button item2} {}} 248 {0 {.tb insert 0 button itemAA} {}} 249 {1 {.tb insert -1 button bogus} {bad toolbar entry index -1}} 250 {0 {.tb delete 0 end} {}} 251 } { 252 set method_status [lindex $test 0] 253 set method_invoke [lindex $test 1] 254 set method [lindex $method_invoke 1] 255 256 set testContents "set msg {}\n" 257 append testContents \ 258 "set result \[catch \{$method_invoke\} msg\]\n" 259 append testContents \ 260 "lappend result \[regexp -- \{[lindex $test 2]\} \$msg\] \n" 261 append testContents "set result\n" 262 test Toolbar-5.$m "\[$method_invoke\]" $testContents \ 263 [list $method_status 1] 264 incr m 265 } 266 267# 268# Conclusion of constrcution/destruction tests 269# 270test Toolbar-1.$c {Toolbar destruction} { 271 destroy .tb 272 update 273} {} 274 275incr c 276 277test Toolbar-1.$c {Toolbar construction} { 278 iwidgets::Toolbar .tb 279 pack .tb 280 update 281 .tb add iwidgets::optionmenu opt 282 update 283 .tb add button b 284 update 285 .tb add frame filler 286 update 287} {} 288 289incr c 290 291test Toolbar-1.$c {Toolbar destruction} { 292 destroy .tb 293 update 294} {} 295 296::tcltest::cleanupTests 297exit 298