Subversion Repositories or1k_old

# This file is a Tcl script to test out [incr Widgets] Notebook 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: notebook.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 Notebook-1.$c {Notebook construction} {

    iwidgets::Notebook .nb

    pack .nb

    update

    .nb add -label one

    update

    .nb add -label two

    update

    .nb add -label three

    update

} {}

incr c

#

# Option tests which are successful.

#

test Notebook-2.$o {configuration option} {

    llength [.nb configure]

} {7}

incr o

foreach test {

        {-width 0 0 }

        {-background #CDCDB7B7B5B5 #CDCDB7B7B5B5 }

        {-auto true true }

        {-height 0 0 }

        {-scrollcommand   }

        {-cursor   }

        } {

        set option [lindex $test 0]

        test Notebook-2.$o "configuration options, $option" {

            .nb configure $option [lindex $test 1]

                lindex [.nb configure $option] 4

        } [lindex $test 2]

        update

        incr o

}

#

# PageConfigure Option tests which are successful.

#

test Notebook-2.$o {page configuration option} {

    llength [.nb pageconfigure 0]

} {8}

# do pageconfigure tests also...

foreach test {

                {0 -label Hello Hello}

                {end -label "Hello World" "Hello World"}

        } {

                set index  [lindex $test 0]

                set option [lindex $test 1]

                test Notebook-2.$o "configuration options, $option" {

                        .nb pageconfigure $index $option [lindex $test 2]

                        lindex [.nb pageconfigure $index $option] 4

                } [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 Notebook-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 {

    {{.nb add}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb add}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb add}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb add -label Never}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb add}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

        {{.nb add -label "Hello World" -disabledforeground gray}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb childsite Never}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb childsite 0}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb childsite end}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb index end}

                {[0-9]+}}

    {{.nb index Never}

                {[0-9]+}}

    {{.nb index 0}

                {0}}

    {{.nb select 0}

                {0}}

    {{.nb select select}

                {0}}

    {{.nb select end}

                {[0-9]+}}

    {{.nb select "Hello World"}

                {[0-9]+}}

    {{.nb insert 0}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb insert select -label "An Insert"}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb insert end -label "Next To Last"}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb select 0}

                {0}}

    {{.nb next}

                {1}}

    {{.nb next}

                {2}}

    {{.nb prev}

                {1}}

    {{.nb prev}

                {0}}

    {{.nb delete Never}

                {}}

    {{.nb delete 1 2}

                {}}

    {{.nb delete 0 "Hello World"}

                {}}

    {{.nb add}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb add}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb add}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb add}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb delete 0 end}

                {}}

    {{.nb add}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb add}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb add}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb add}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb select 2}

                {[-]*[0-9]+}}

    {{.nb delete select end}

                {}}

    {{.nb delete 0 end}

                {}}

    {{.nb add -label "First Page"}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb add -label "Second Page"}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb add -label "Third Page"}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb add -label "Fourth Page"}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb add -label "Fifth Page"}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb add -label "Sixth Page"}

                {[.]nb[.]cs[.]page[0-9]+[.]cs}}

    {{.nb select "First Page"}

                {[-]*[0-9]+}}

    {{.nb delete select "Second Page"}

                {}}

    {{.nb delete "Third Page" 1}

                {}}

    {{.nb delete "Fifth Page" "Sixth Page"}

                {}}

        } {

        set method [lindex [lindex $test 0] 1]

        set method_invoke [lindex $test 0]

        test_pattern Notebook-3.$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 {

                {{.nb delete 0 end} {}}

                {{.nb childsite 0} {can't get childsite, no pages}}

                {{.nb add} {}}

                {{.nb childsite 1} {bad Notebook page index in childsite method}}

                {{.nb childsite -1} {bad Notebook page index in childsite method}}

                {{.nb delete 0} {}}

                {{.nb delete 0} {can't delete page, no pages}}

                {{.nb add} {}}

                {{.nb delete 1} {bad Notebook page index in delete method:}}

                {{.nb delete select} {bad Notebook page index in delete method:}}

                {{.nb delete 0} {}}

                {{.nb add} {}}

                {{.nb delete 0 1} {bad Notebook page index2 in delete method:}}

                {{.nb delete 1 4} {bad Notebook page index1 in delete method:}}

                {{.nb add} {}}

                {{.nb delete 1 0} {bad Notebook page index1 in delete method: index1 is greater than index2}}

                {{.nb delete 0 1} {}}

                {{.nb add} {}}

                {{.nb delete 0 1 4 5 6} {wrong # args}}

                {{.nb delete} {wrong # args}}

                {{.nb delete 0} {}}

                {{.nb delete 0} {can't delete page}}

                {{.nb delete select} {can't delete page}}

                {{.nb insert 0} {can't insert page}}

                {{.nb add} {}}

                {{.nb add} {}}

                {{.nb insert 2} {bad Notebook page index in insert method:}}

                {{.nb insert -1} {bad Notebook page index}}

                {{.nb delete 0 end} {}}

                {{.nb next} {can't move to next page, no pages in the notebook}}

                {{.nb prev} {can't move to previous page, no pages in the notebook}}

                {{.nb select 0} {can't select page}}

                {{.nb add} {}}

                {{.nb select 1} {bad Notebook page index in select method:}}

                {{.nb delete 0} {}}

        } {

                set method [lindex [lindex $test 0] 1]

                set method_invoke [lindex $test 0]

                test_pattern Notebook-3.$m "\[$method_invoke\]" {

                        list [catch {eval [lindex $test 0]} msg] $msg

                } [list 1 [lindex $test 1]]

        incr m

        }

# Conclusion of constrcution/destruction tests

#

test Notebook-1.$c {Notebook destruction} {

    destroy .nb

    update

} {}

incr c

test Notebook-1.$c {Notebook construction} {

    iwidgets::Notebook .nb -width 100 -height 100

    pack .nb

    update

    .nb add -label one

    update

    .nb add -label two

    update

    .nb add -label three

    update

} {}

incr c

test Notebook-1.$c {Notebook destruction} {

        destroy .nb

    update

} {}