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

} {}