itcl/iwidgets3.0.0/tests/toolbar.test

   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$
  15
  16 package require tcltest
  17 namespace import -force ::tcltest::*
  18
  19 package require Iwidgets 3.0
  20
  21 if {[string compare test [info procs test]] == 1} {
  22     source defs
  23 }
  24
  25 wm geometry . {}
  26 raise .
  27
  28 set c 1
  29 set o 1
  30 set m 1
  31
  32 #
  33 # Initial construction test
  34 #
  35 test Toolbar-1.$c {Toolbar construction} {
  36     iwidgets::Toolbar .tb
  37     pack .tb
  38     update
  39     .tb add button item1 -text item1
  40     update
  41     .tb add button item2 -text item2
  42     update
  43     .tb add button item3 -text item3
  44     update
  45 } {}
  46
  47 incr c
  48
  49 #
  50 # Option tests which are successful.
  51 #
  52 test Toolbar-2.$o {configuration option} {
  53     llength [.tb configure]
  54 } {27}
  55
  56 incr o
  57
  58 foreach test {
  59         {-disabledforeground #a3a3a3 #a3a3a3 }
  60         {-highlightthickness 0 0 }
  61         {-selectborderwidth 4 4  }
  62         {-balloonfont 6x10 6x10 }
  63         {-balloondelay1 1000 1000 }
  64         {-balloondelay2 200 200 }
  65         {-borderwidth 2 2 }
  66         {-selectcolor #CDCDB7B7B5B5 #CDCDB7B7B5B5 }
  67         {-highlightcolor Black Black }
  68         {-font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* }
  69         {-balloonbackground yellow yellow }
  70         {-helpvariable testing testing}
  71         {-troughcolor #c3c3c3 #c3c3c3 }
  72         {-selectbackground #c3c3c3 #c3c3c3 }
  73         {-highlightbackground #d9d9d9 #d9d9d9 }
  74         {-background #CDCDB7B7B5B5 #CDCDB7B7B5B5 }
  75         {-state normal normal }
  76         {-balloonforeground black black }
  77         {-selectforeground Black Black }
  78         {-foreground #000000000000 #000000000000 }
  79         {-activebackground #ececec #ececec }
  80         {-insertbackground Black Black }
  81         {-cursor crosshair crosshair  }
  82         {-activeforeground Black Black }
  83         {-insertforeground Black Black }
  84         {-orient horizontal horizontal }
  85         } {
  86         set option [lindex $test 0]
  87         test Toolbar-2.$o "configuration options, $option" {
  88             .tb configure $option [lindex $test 1]
  89                 .tb cget $option
  90         } [lindex $test 2]
  91         update
  92         incr o
  93 }
  94
  95 #
  96 # Itemconfigure Option tests which are successful.
  97 #
  98 # This happens to be for a button...
  99 set o 0
 100 test Toolbar-3.$o {tab configuration option} {
 101     llength [.tb itemconfigure 0]
 102 } {33}
 103
 104 # do itemconfigure tests also...
 105 foreach test {
 106         {0 -activebackground #ececec #ececec }
 107         {0 -activeforeground Black Black }
 108         {0 -anchor center center }
 109         {0 -background #d9d9d9 #d9d9d9 }
 110         {0 -bd 0 0 }
 111         {0 -bg #d9d9d9 #d9d9d9  }
 112         {0 -bitmap {} {} }
 113         {0 -borderwidth 2 2 }
 114         {0 -command {} {} }
 115         {0 -cursor {} {} }
 116         {0 -disabledforeground #a3a3a3 #a3a3a3 }
 117         {0 -fg Black Black }
 118         {0 -font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* }
 119         {0 -foreground Black Black }
 120         {0 -height 0 0 }
 121         {0 -highlightbackground #d9d9d9 #d9d9d9 }
 122         {0 -highlightcolor Black Black }
 123         {0 -highlightthickness 2 2 }
 124         {0 -image  {} {} }
 125         {0 -justify center center }
 126         {0 -padx 4 4 }
 127         {0 -pady 4 4 }
 128         {0 -relief raised raised }
 129         {0 -state normal normal }
 130         {0 -takefocus false false  }
 131         {0 -text {} {} }
 132         {0 -textvariable {} {}  }
 133         {0 -underline -1 -1 }
 134         {0 -width 0 0 }
 135         {0 -wraplength 0 0 }
 136         {0 -helpstr {} {} }
 137         {0 -balloonstr {} {} }
 138         } {
 139                 set index  [lindex $test 0]
 140                 set option [lindex $test 1]
 141                 test Toolbar-2.$o "tab configuration options, $option" {
 142                         .tb itemconfigure $index $option [lindex $test 2]
 143                         .tb itemcget $index $option
 144                 } [lindex $test 3]
 145         update
 146         incr o
 147 }
 148
 149 #
 150 # Option tests which fail and produce errors.
 151 #
 152 #foreach test {
 153 #       { -OPTION BADVALUE {ERROR_MESSAGE} }
 154 #       } {
 155 #       set option [lindex $test 0]
 156 #        test Toolbar-2.$o "configuration options, $option" {
 157 #           list [catch {.bb configure $option [lindex $test 1]} msg] $msg
 158 #       } [list 1 [lindex $test 2]]
 159 #       incr o
 160 #}
 161
 162 #
 163 # Method tests which are successful.
 164 #
 165 foreach test {
 166     {{.tb delete 0 end}
 167                 {}}
 168     {{.tb add radiobutton one}
 169                 {.tb.one}}
 170     {{.tb index end}
 171                 {0}}
 172     {{.tb add checkbutton two}
 173                 {.tb.two}}
 174     {{.tb index end}
 175                 {1}}
 176     {{.tb index one}
 177                 {0}}
 178     {{.tb insert end button oneandhalf -text "One & half"}
 179                 {.tb.oneandhalf}}
 180     {{.tb index oneandhalf}
 181                 {1}}
 182     {{.tb delete oneandhalf}
 183                 {}}
 184     {{.tb index two}
 185                 {1}}
 186     {{.tb delete 0 end}
 187                 {}}
 188     {{.tb index 0}
 189                 {-1}}
 190         } {
 191         set method [lindex [lindex $test 0] 1]
 192         set method_invoke [lindex $test 0]
 193
 194         set testContents "set msg {}\n"
 195         append testContents \
 196             "set result \[catch \{[lindex $test 0]\} msg\]\n"
 197         append testContents \
 198             "lappend result \[regexp -- \{[lindex $test 1]\} \$msg\] \n"
 199         append testContents "set result\n"
 200         test Toolbar-4.$m "\[$method_invoke\]" $testContents \
 201                 [list 0 1]
 202         update
 203         incr m
 204 }
 205
 206 #
 207 # Method tests which fail and produce errors
 208 #
 209 foreach test {
 210                 {1 {.tb delete 0 end} {}}
 211                 {0 {.tb add button item1} {}}
 212                 {0 {.tb delete 0} {}}
 213                 {1 {.tb delete 0} {can't delete widget, no widgets in the Toolbar}}
 214                 {0 {.tb add button item1} {}}
 215                 {1 {.tb delete 1} {bad Toolbar widget index in delete method}}
 216                 {0 {.tb delete 0} {}}
 217                 {0 {.tb add button item1} {}}
 218                 {1 {.tb delete 0 1} {bad Toolbar widget index2 in delete method}}
 219                 {1 {.tb delete 1 4} {bad Toolbar widget index1 in delete method}}
 220                 {0 {.tb add button item2} {}}
 221                 {1 {.tb delete 1 0} {bad Toolbar widget index1 in delete method}}
 222                 {0 {.tb delete 0 1} {}}
 223                 {0 {.tb add button item1} {}}
 224                 {1 {.tb delete 0 1 4 5 6} {wrong # args}}
 225                 {1 {.tb delete} {wrong # args}}
 226                 {0 {.tb delete 0} {}}
 227                 {1 {.tb delete 0} {can't delete widget, no widgets in the Toolbar}}
 228                 {1 {.tb insert 0 button itemA} {}}
 229                 {0 {.tb add button item1} {}}
 230                 {0 {.tb add button item2} {}}
 231                 {0 {.tb insert 0 button itemAA} {}}
 232                 {1 {.tb insert -1 button bogus} {bad toolbar entry index -1}}
 233                 {0 {.tb delete 0 end} {}}
 234         } {
 235                 set method_status [lindex $test 0]
 236                 set method_invoke [lindex $test 1]
 237                 set method [lindex $method_invoke 1]
 238
 239                 set testContents "set msg {}\n"
 240                 append testContents \
 241                     "set result \[catch \{$method_invoke\} msg\]\n"
 242                 append testContents \
 243                     "lappend result \[regexp -- \{[lindex $test 2]\} \$msg\] \n"
 244                 append testContents "set result\n"
 245                 test Toolbar-5.$m "\[$method_invoke\]" $testContents \
 246                         [list $method_status 1]
 247         incr m
 248         }
 249
 250 #
 251 # Conclusion of constrcution/destruction tests
 252 #
 253 test Toolbar-1.$c {Toolbar destruction} {
 254     destroy .tb
 255     update
 256 } {}
 257
 258 incr c
 259
 260 test Toolbar-1.$c {Toolbar construction} {
 261     iwidgets::Toolbar .tb
 262     pack .tb
 263     update
 264     .tb add iwidgets::optionmenu opt
 265     update
 266     .tb add button b
 267     update
 268     .tb add frame filler
 269     update
 270 } {}
 271
 272 incr c
 273
 274 test Toolbar-1.$c {Toolbar destruction} {
 275         destroy .tb
 276     update
 277 } {}
 278
 279 ::tcltest::cleanupTests
 280 exit