Subversion Repositories or1k

# This file is a Tcl script to test out [incr Widgets] Menubar 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: menubar.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 Menubar-1.$c {Menubar construction} {
    iwidgets::Menubar .mb -menubuttons {
                menubutton file -text File -menu {
                        options -tearoff no
                        command ok -label "Ok"
                        command quit -label "Quit"
                }
        }
    pack .mb 
    update 
    .mb add menubutton .other -text Other -menu {
                radiobutton r1 -label "Radio One"
                radiobutton r2 -label "Radio Two"
        }
    update 
        .mb add menubutton view -text View -menu {
                command uno -label Uno
                command dos -label Dos
        }
        update
        .mb add cascade .view.more -label More -menu {
                command one -label One
                command two -label Two
                cascade extra -label Extra -menu {
                        radiobutton rad1 -label "Choice One"
                        radiobutton rad2 -label "Choice Two"
                        cascade somemore \
                                        -label "Some More" \
                                        -helpstr "Yet some more" \
                                        -menu {
                                command triangle -label "Triangle" -command {puts TRIANGLE}
                                command square -label "Square" -command {puts SQUARE}
                                command octagon -label "Octagon" -command {puts OCTAGON}
                        }
                }
        }
    update 
} {}

incr c

#
# Option tests which are successful.
#
test Menubar-2.$o {configuration option} {
    llength [.mb configure]
} {22}

incr o

foreach test {
        {-anchor center center }
        {-disabledforeground #a3a3a3 #a3a3a3 }
        {-menubuttons {} {} }
        {-highlightthickness 0 0 }
        {-borderwidth 2 2 }
        {-helpvariable {} {} }
        {-highlightcolor Black Black }
        {-font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* }
        {-background #CDCDB7B7B5B5 #CDCDB7B7B5B5 }
        {-highlightbackground #d9d9d9 #d9d9d9 }
        {-activeborderwidth 2 2 }
        {-wraplength 0 0 }
        {-activebackground #ececec #ececec }
        {-padx 4 4 }
        {-pady 4 4 }
        {-justify center center }
        {-cursor {} {} }
        {-activeforeground black black }
        {-width 0 0 }
        {-height 0 0 }
        } {
        set option [lindex $test 0]
        test Menubar-2.$o "configuration options, $option" {
            .mb configure $option [lindex $test 1] 
                .mb cget $option
        } [lindex $test 2]
        update 
        incr o
}

#
# Menuconfigure Option tests which are successful.
#
# This happens to be for a command...
test Menubar-3.$o {menubar menuconfiguration option} {
    llength [.mb menuconfigure .file.quit]
} {15}

# do menuconfigure tests also...
foreach test {
        { .file.quit -activebackground red red }
        { .file.quit -activeforeground red red }
        { .file.quit -accelerator {} {}  }
        { .file.quit -background red red }
        { .file.quit -bitmap {} {} }
        { .file.quit -command {} {}   }
        { .file.quit -font fixed fixed  }
        { .file.quit -foreground  red red }
        { .file.quit -image {} {} }
        { .file.quit -label hello hello }
        { .file.quit -state normal normal }
        { .file.quit -underline -1 -1 }
        { .file.quit -helpstr {} {} }
        } {
                set index  [lindex $test 0]
                set option [lindex $test 1]
                test Menubar-2.$o "tab configuration options, $option" {
                        .mb menuconfigure $index $option [lindex $test 2] 
                        .mb menucget $index $option
                } [lindex $test 3]
        update 
        incr o
}

# test on cascade item
# This happens to be for a cascade...
test Menubar-3.$o {menubar menuconfiguration option} {
    llength [.mb menuconfigure .view.more]
} {17}

# do menuconfigure tests also...
foreach test {
        { .view.more -activebackground red red }
        { .view.more -activeforeground red red }
        { .view.more -accelerator {} {}  }
        { .view.more -background  red red}
        { .view.more -bitmap {} {}  }
        { .view.more -command {} {}  }
        { .view.more -font   }
        { .view.more -foreground   }
        { .view.more -image {} {}  }
        { .view.more -label {} {}  }
        { .view.more -state normal normal }
        { .view.more -underline -1 -1 }
        { .view.more -helpstr {} {} }
        } {
                set index  [lindex $test 0]
                set option [lindex $test 1]
                test Menubar-2.$o "tab configuration options, $option" {
                        .mb menuconfigure $index $option [lindex $test 2] 
                        .mb menucget $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 Menubar-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 {
    {{.mb delete 0 end}
                {}}
        {{.mb add menubutton .help -text Help}
                {}}
        {{.mb add command .help.context -label "On Context..."}
                {}}
        {{.mb insert .help.context command index -label "By Index..."}
                {}}
        {{.mb delete .help}
                {}}
        {{.mb add menubutton .help -text HELP -menu {
                        command index -label "By Index..."
                        command context -label "By Context..."
                        separator sep1
                        command keyword -label "By Keyword..."
                }}
                {}}
        {{.mb delete .help.sep1 .help.keyword}
                {}}
        {{.mb menuconfigure .help -text HeLp -menu {
                        command index -label "By Index..."
                        command context -label "By Context..."
                        separator sep1
                        command keyword -label "By Keyword..."
                }}
                {}}
        {{.mb configure -menubuttons {
                menubutton file -text File -menu {
                        options -tearoff $tearoff
                        command ok -label $okLabel
                        command quit -label $quitLabel
                        }
                }}
                {}}
        {{.mb add menubutton .other -text Other -menu {
                radiobutton r1 -label "Radio One"
                radiobutton r2 -label "Radio Two"
        }}
                {}}
        {{.mb insert .other menubutton view -text View -menu {
                command uno -label Uno
                command dos -label Dos
        }}
                {}}
        {{.mb add cascade .view.more -label More -menu {
                command one -label One
                command two -label Two
                cascade extra -label Extra -menu {
                        radiobutton rad1 -label "Choice One"
                        radiobutton rad2 -label "Choice Two"
                        cascade somemore \
                                        -label "Some More" \
                                        -helpstr "Yet some more" \
                                        -menu {
                                command triangle -label "Triangle" -command {puts TRIANGLE}
                                command square -label "Square" -command {puts SQUARE}
                                command octagon -label "Octagon" -command {puts OCTAGON}
                        }
                }
        }}
                {}}
        {{.mb insert .view.uno cascade before -label Before -menu {
                command red -label Red
                command green -label Green
                command blue -label Blue
        }}
                {}}
        {{.mb add menubutton .help -text Help}
                {}}
        {{.mb add command .help.context -label "On Context..."}
                {}}
        {{.mb insert .help.context command index -label "By Index..."}
                {}}
        {{.mb insert .view.before.green cascade colors -label Colors -menu {
                command orange -label Orange -command "puts ORANGE" -helpstr "orange"
                separator sep1
                command purple -label Purple
        }}

                {}}
        {{.mb insert .view.before.colors.purple cascade morecolors -label "More Colors" -menu {}}
                {}}
        {{.mb add command .view.before.colors.morecolors.pink -label Pink}
                {}}
        {{.mb add command .view.before.colors.morecolors.peach -label Peach}
                {}}
        {{.mb add command .view.before.colors.morecolors.yellow -label Yellow}
                {}}
        {{.mb menuconfigure .view -text VIEW -menu {
                command o -label OH -command {puts OH}
                cascade negative -label Negative -menu {
                        command print -label Print
                        command save -label Save
                }
                # Comments are supported.
#               command dummy -label PlaceHolder
                cascade plus -label Plus -menu {
                        command yep -label Yep
                        command nope -label Nope
                }
        }}
                {}}
        {{.mb menuconfigure .view.negative -label NEGATIVE -menu {
                command print -label PRINT
                command save -label SAVE
        }}
                {}}
        {{.mb delete .0 .end}
                {}}
        } {
        set method [lindex [lindex $test 0] 1]
        set method_invoke [lindex $test 0]
        test_pattern Menubar-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 or results
# Specifically, deals with method invocation on empty menubar.
#
foreach test {
                {{.mb delete .0 .last} 
                        {bad path:}}
                {{.mb index .0} 
                        {-1}}
                {{.mb index .end} 
                        {-1}}
                {{.mb index .last} 
                        {-1}}
                {{.mb index .help} 
                        {-1}}
                {{.mb delete .0} 
                        {bad path:}}
                {{.mb delete .end} 
                        {bad path:}}
                {{.mb delete .last} 
                        {bad path:}}
                {{.mb delete .help} 
                        {bad path:}}
                {{.mb insert .0 menubutton file -text File} 
                        {bad path:}}
                {{.mb insert .end menubutton file -text File} 
                        {bad path:}}
                {{.mb insert .last menubutton file -text File} 
                        {bad path:}}
                {{.mb insert .help menubutton file -text File} 
                        {bad path:}}
                {{.mb invoke .0.0} 
                        {bad path:}}
                {{.mb invoke .end.0} 
                        {bad path:}}
                {{.mb invoke .last.0} 
                        {bad path:}}
                {{.mb invoke .help.0} 
                        {bad path:}}
                {{.mb menucget .0 -text} 
                        {bad path:}}
                {{.mb menucget .end -text} 
                        {bad path:}}
                {{.mb menucget .last -text} 
                        {bad path:}}
                {{.mb menucget .help -text} 
                        {bad path:}}
                {{.mb menuconfigure .0 -text} 
                        {bad path:}}
                {{.mb menuconfigure .end -text} 
                        {bad path:}}
                {{.mb menuconfigure .last -text} 
                        {bad path:}}
                {{.mb menuconfigure .help -text} 
                        {bad path:}}
                {{.mb path *quit} 
                        {}}
                {{.mb type .0.0} 
                        {bad path:}}
                {{.mb type .0.end} 
                        {bad path:}}
                {{.mb type .0.last} 
                        {bad path:}}
                {{.mb type .0.new} 
                        {bad path:}}
                {{.mb yposition .0.new} 
                        {bad path:}}
        } {
                set method [lindex [lindex $test 0] 1]
                set method_invoke [lindex $test 0]
                test_pattern Menubar-5.$m "\[$method_invoke\]" {
                        list [catch {eval [lindex $test 0]} msg] $msg
                } [list 1 [lindex $test 1]]
        incr m
        }

#
# Method tests which fail and produce errors or results
# On a non-empty menubar...
foreach test {
                {{.mb configure -menubuttons {
                        menubutton file -text File -menu {
                                options -tearoff no
                                command ok -label "Ok"
                                command quit -label "Quit"
                        }
                }}
                        {}}
                {{.mb delete .file.hello} 
                        {bad path}}
                {{.mb index .0.hello} 
                        {-1}}
                {{.mb index .0.quit} 
                        {1}}
                {{.mb index 0.end} 
                        {1}}
                {{.mb index .file.last} 
                        {1}}
                {{.mb index .file.ok} 
                        {0}}
                {{.mb delete .view .file}
                        {bad path:}}
                {{.mb delete .file .help}
                        {bad path:}}
                {{.mb add command .file.menu}
                        {bad name}}
                {{.mb add command .file.last}
                        {bad name}}
                {{.mb add command .file.end}
                        {bad name}}
                {{.mb add command .file.2}
                        {bad name}}
                {{.mb insert .0 menu view -text View} 
                        {bad type}}
                {{.mb insert .file command view -text View} 
                        {bad entry path}}
                {{.mb insert .file menubutton view -text View} 
                        {[.]mb[.]menubar[.]view}}
                {{.mb invoke .0.quit} 
                        {bad path}}
                {{.mb menucget .0 -text} 
                        {View}}
                {{.mb menucget .end -text} 
                        {File}}
                {{.mb menucget .last -text} 
                        {File}}
                {{.mb menucget .help -text} 
                        {bad path}}
                {{.mb menuconfigure .0 -text} 
                        {-text text Text {} View}}
                {{.mb menuconfigure .end.last -label} 
                        {-label {} {} {} Quit}}
                {{.mb menuconfigure .last -text} 
                        {-text text Text {} File}}
                {{.mb menuconfigure .help -text} 
                        {bad path}}
                {{.mb path *quit} 
                        {[.]file[.]quit}}
                {{.mb type .end.0} 
                        {command}}
                {{.mb type .end.end} 
                        {command}}
                {{.mb type .end.last} 
                        {command}}
                {{.mb type .0.new} 
                        {bad path}}
        } {
                set method [lindex [lindex $test 0] 1]
                set method_invoke [lindex $test 0]
                test_pattern Menubar-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 Menubar-1.$c {Menubar destruction} {
    destroy .mb
    update 
} {}

incr c

test Menubar-1.$c {Menubar construction} {
    iwidgets::Menubar .mb -menubuttons {
                menubutton file -text File -menu {
                        options -tearoff no
                        command ok -label "Ok"
                        command quit -label "Quit"
                }
        }
    pack .mb 
    update 
    .mb add menubutton .other -text Other -menu {
                radiobutton r1 -label "Radio One"
                radiobutton r2 -label "Radio Two"
        }
    update 
        .mb add menubutton view -text View -menu {
                command uno -label Uno
                command dos -label Dos
        }
        update
        .mb add cascade .view.more -label More -menu {
                command one -label One
                command two -label Two
                cascade extra -label Extra -menu {
                        radiobutton rad1 -label "Choice One"
                        radiobutton rad2 -label "Choice Two"
                        cascade somemore \
                                        -label "Some More" \
                                        -helpstr "Yet some more" \
                                        -menu {
                                command triangle -label "Triangle" -command {puts TRIANGLE}
                                command square -label "Square" -command {puts SQUARE}
                                command octagon -label "Octagon" -command {puts OCTAGON}
                        }
                }
        }
    update 
} {}

incr c

test Menubar-1.$c {Menubar destruction} {
        destroy .mb
    update 
} {}