diff options
Diffstat (limited to 'itcl/iwidgets/tests/toolbar.test')
| -rw-r--r-- | itcl/iwidgets/tests/toolbar.test | 297 |
1 files changed, 297 insertions, 0 deletions
diff --git a/itcl/iwidgets/tests/toolbar.test b/itcl/iwidgets/tests/toolbar.test new file mode 100644 index 00000000000..614ff6f321f --- /dev/null +++ b/itcl/iwidgets/tests/toolbar.test @@ -0,0 +1,297 @@ +# This file is a Tcl script to test out [incr Widgets] Toolbar class. +# It is organized in the standard fashion for Tcl tests with the following +# notation for test case labels: +# +# 1.x - Construction/Destruction tests +# 2.x - Configuration option tests +# 3.x - Method tests +# +# Copyright (c) 1995 DSC Technologies Corporation +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# @(#) $Id$ + +package require tcltest +namespace import -force ::tcltest::* + +if [catch {package require Iwidgets 4.0}] { + # Let's try modifying the auto_path. Note that the IWIDGETS_LIBRARY + # env var is initialized in the Makefile when doing a 'make test'. + # If sourcing this file independently, this variable must be set manually. + if ![info exists env(IWIDGETS_LIBRARY)] { + error "Unable to locate Iwidgets package. Set your IWIDGETS_LIBRARY\ + environment\nvariable to the directory that contains iwidgets.tcl" + } + lappend auto_path $env(IWIDGETS_LIBRARY) + package require Iwidgets 4.0 +} + +if {[string compare test [info procs test]] == 1} { + source defs +} + +wm geometry . {} +raise . + +set c 1 +set o 1 +set m 1 + +# +# Initial construction test +# +test Toolbar-1.$c {Toolbar construction} { + iwidgets::Toolbar .tb + pack .tb + update + .tb add button item1 -text item1 + update + .tb add button item2 -text item2 + update + .tb add button item3 -text item3 + update +} {} + +incr c + +# +# Option tests which are successful. +# +test Toolbar-2.$o {configuration option} { + llength [.tb configure] +} {27} + +incr o + +foreach test { + {-disabledforeground #a3a3a3 #a3a3a3 } + {-highlightthickness 0 0 } + {-selectborderwidth 4 4 } + {-balloonfont 6x10 6x10 } + {-balloondelay1 1000 1000 } + {-balloondelay2 200 200 } + {-borderwidth 2 2 } + {-selectcolor #CDCDB7B7B5B5 #CDCDB7B7B5B5 } + {-highlightcolor Black Black } + {-font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* } + {-balloonbackground yellow yellow } + {-helpvariable testing testing} + {-troughcolor #c3c3c3 #c3c3c3 } + {-selectbackground #c3c3c3 #c3c3c3 } + {-highlightbackground #d9d9d9 #d9d9d9 } + {-background #CDCDB7B7B5B5 #CDCDB7B7B5B5 } + {-state normal normal } + {-balloonforeground black black } + {-selectforeground Black Black } + {-foreground #000000000000 #000000000000 } + {-activebackground #ececec #ececec } + {-insertbackground Black Black } + {-cursor crosshair crosshair } + {-activeforeground Black Black } + {-insertforeground Black Black } + {-orient horizontal horizontal } + } { + set option [lindex $test 0] + test Toolbar-2.$o "configuration options, $option" { + .tb configure $option [lindex $test 1] + .tb cget $option + } [lindex $test 2] + update + incr o +} + +# +# Itemconfigure Option tests which are successful. +# +# This happens to be for a button. Note that the configuration options for +# the Tk button changed in 8.4. Four new options were added. +set newoptions [list -compound -overrelief -repeatdelay -repeatinterval] +set o 0 +if {$::tk_version < 8.4} { + test Toolbar-3.$o {tab configuration option} { + llength [.tb itemconfigure 0] + } {33} +} else { + test Toolbar-3.$o {tab configuration option} { + llength [.tb itemconfigure 0] + } {37} +} + +# do itemconfigure tests also... +foreach test { + {0 -activebackground #ececec #ececec } + {0 -activeforeground Black Black } + {0 -anchor center center } + {0 -background #d9d9d9 #d9d9d9 } + {0 -bd 0 0 } + {0 -bg #d9d9d9 #d9d9d9 } + {0 -bitmap {} {} } + {0 -borderwidth 2 2 } + {0 -command {} {} } + {0 -compound none none } + {0 -cursor {} {} } + {0 -default disabled disabled } + {0 -disabledforeground #a3a3a3 #a3a3a3 } + {0 -fg Black Black } + {0 -font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* } + {0 -foreground Black Black } + {0 -height 0 0 } + {0 -highlightbackground #d9d9d9 #d9d9d9 } + {0 -highlightcolor Black Black } + {0 -highlightthickness 2 2 } + {0 -image {} {} } + {0 -justify center center } + {0 -overrelief {} {} } + {0 -padx 4 4 } + {0 -pady 4 4 } + {0 -relief raised raised } + {0 -repeatdelay 0 0 } + {0 -repeatinterval 0 0 } + {0 -state normal normal } + {0 -takefocus false false } + {0 -text {} {} } + {0 -textvariable {} {} } + {0 -underline -1 -1 } + {0 -width 0 0 } + {0 -wraplength 0 0 } + {0 -helpstr {} {} } + {0 -balloonstr {} {} } + } { + set option [lindex $test 1] + if {$::tk_version < 8.4} { + if {[lsearch $newoptions $option] != -1} { + # Skip it. + continue + } + } + set index [lindex $test 0] + test Toolbar-2.$o "tab configuration options, $option" { + .tb itemconfigure $index $option [lindex $test 2] + .tb itemcget $index $option + } [lindex $test 3] + update + incr o +} + + +# +# Method tests which are successful. +# +foreach test { + {{.tb delete 0 end} + {}} + {{.tb add radiobutton one} + {.tb.one}} + {{.tb index end} + {0}} + {{.tb add checkbutton two} + {.tb.two}} + {{.tb index end} + {1}} + {{.tb index one} + {0}} + {{.tb insert end button oneandhalf -text "One & half"} + {.tb.oneandhalf}} + {{.tb index oneandhalf} + {1}} + {{.tb delete oneandhalf} + {}} + {{.tb index two} + {1}} + {{.tb delete 0 end} + {}} + {{.tb index 0} + {-1}} + } { + set method [lindex [lindex $test 0] 1] + set method_invoke [lindex $test 0] + + set testContents "set msg {}\n" + append testContents \ + "set result \[catch \{[lindex $test 0]\} msg\]\n" + append testContents \ + "lappend result \[regexp -- \{[lindex $test 1]\} \$msg\] \n" + append testContents "set result\n" + test Toolbar-4.$m "\[$method_invoke\]" $testContents \ + [list 0 1] + update + incr m +} + +# +# Method tests which fail and produce errors +# +foreach test { + {1 {.tb delete 0 end} {}} + {0 {.tb add button item1} {}} + {0 {.tb delete 0} {}} + {1 {.tb delete 0} {can't delete widget, no widgets in the Toolbar}} + {0 {.tb add button item1} {}} + {1 {.tb delete 1} {bad Toolbar widget index in delete method}} + {0 {.tb delete 0} {}} + {0 {.tb add button item1} {}} + {1 {.tb delete 0 1} {bad Toolbar widget index2 in delete method}} + {1 {.tb delete 1 4} {bad Toolbar widget index1 in delete method}} + {0 {.tb add button item2} {}} + {1 {.tb delete 1 0} {bad Toolbar widget index1 in delete method}} + {0 {.tb delete 0 1} {}} + {0 {.tb add button item1} {}} + {1 {.tb delete 0 1 4 5 6} {wrong # args}} + {1 {.tb delete} {wrong # args}} + {0 {.tb delete 0} {}} + {1 {.tb delete 0} {can't delete widget, no widgets in the Toolbar}} + {1 {.tb insert 0 button itemA} {}} + {0 {.tb add button item1} {}} + {0 {.tb add button item2} {}} + {0 {.tb insert 0 button itemAA} {}} + {1 {.tb insert -1 button bogus} {bad toolbar entry index -1}} + {0 {.tb delete 0 end} {}} + } { + set method_status [lindex $test 0] + set method_invoke [lindex $test 1] + set method [lindex $method_invoke 1] + + set testContents "set msg {}\n" + append testContents \ + "set result \[catch \{$method_invoke\} msg\]\n" + append testContents \ + "lappend result \[regexp -- \{[lindex $test 2]\} \$msg\] \n" + append testContents "set result\n" + test Toolbar-5.$m "\[$method_invoke\]" $testContents \ + [list $method_status 1] + incr m + } + +# +# Conclusion of constrcution/destruction tests +# +test Toolbar-1.$c {Toolbar destruction} { + destroy .tb + update +} {} + +incr c + +test Toolbar-1.$c {Toolbar construction} { + iwidgets::Toolbar .tb + pack .tb + update + .tb add iwidgets::optionmenu opt + update + .tb add button b + update + .tb add frame filler + update +} {} + +incr c + +test Toolbar-1.$c {Toolbar destruction} { + destroy .tb + update +} {} + +::tcltest::cleanupTests +exit |