Subversion Repositories or1k

# 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: toolbar.test,v 1.1.1.1 2002-01-16 10:24:51 markom Exp $

package require Iwidgets 3.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...
set o 0
test Toolbar-3.$o {tab configuration option} {
    llength [.tb itemconfigure 0]
} {33}

# 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 -cursor {} {} }
        {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 -padx 4 4 }
        {0 -pady 4 4 }
        {0 -relief raised raised }
        {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 index  [lindex $test 0]
                set option [lindex $test 1]
                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
}

#
# Option tests which fail and produce errors.
#
#foreach test {
#       { -OPTION BADVALUE {ERROR_MESSAGE} }
#       } {
#       set option [lindex $test 0]
#        test Toolbar-2.$o "configuration options, $option" {
#           list [catch {.bb configure $option [lindex $test 1]} msg] $msg
#       } [list 1 [lindex $test 2]]
#       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]
        test_pattern Toolbar-4.$m "\[$method_invoke\]" {
            list [catch {eval [lindex $test 0]} msg] $msg
        } [list 0 [lindex $test 1]]
        update 
        incr m
}

#
# Method tests which fail and produce errors
#
foreach test {
                {{.tb delete 0 end} {}}
                {{.tb add button item1} {}}
                {{.tb delete 0} {}}
                {{.tb delete 0} {can't delete widget, no widgets in the Toolbar}}
                {{.tb add button item1} {}}
                {{.tb delete 1} {bad Toolbar widget index in delete method}}
                {{.tb delete 0} {}}
                {{.tb add button item1} {}}
                {{.tb delete 0 1} {bad Toolbar widget index2 in delete method}}
                {{.tb delete 1 4} {bad Toolbar widget index1 in delete method}}
                {{.tb add button item2} {}}
                {{.tb delete 1 0} {bad Toolbar widget index1 in delete method}}
                {{.tb delete 0 1} {}}
                {{.tb add button item1} {}}
                {{.tb delete 0 1 4 5 6} {wrong # args}}
                {{.tb delete} {wrong # args}}
                {{.tb delete 0} {}}
                {{.tb delete 0} {can't delete widget, no widgets in the Toolbar}}
                {{.tb insert 0 button itemA} {}}
                {{.tb add button item1} {}}
                {{.tb add button item2} {}}
                {{.tb insert 0 button itemAA} {}}
                {{.tb insert -1 button bogus} {bad toolbar entry index -1}}
                {{.tb delete 0 end} {}}
        } {
                set method [lindex [lindex $test 0] 1]
                set method_invoke [lindex $test 0]
                test_pattern Toolbar-5.$m "\[$method_invoke\]" {
                        list [catch {eval [lindex $test 0]} msg] $msg
                } [list 1 [lindex $test 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 
} {}