# 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.4 2001/08/07 19:56:48 smithc Exp $ 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 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 { {0 {.nb add} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb add} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb add} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb add -label Never} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb add} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb add -label "Hello World" -disabledforeground gray} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb childsite Never} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb childsite 0} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb childsite end} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb index end} {[0-9]+}} {0 {.nb index Never} {[0-9]+}} {0 {.nb index 0} {0}} {0 {.nb select 0} {0}} {0 {.nb select select} {0}} {0 {.nb select end} {[0-9]+}} {0 {.nb select "Hello World"} {[0-9]+}} {0 {.nb insert 0} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb insert select -label "An Insert"} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb insert end -label "Next To Last"} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb select 0} {0}} {0 {.nb next} {1}} {0 {.nb next} {2}} {0 {.nb prev} {1}} {0 {.nb prev} {0}} {0 {.nb delete Never} {}} {0 {.nb delete 1 2} {}} {0 {.nb delete 0 "Hello World"} {}} {0 {.nb add} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb add} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb add} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb add} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb delete 0 end} {}} {0 {.nb add} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb add} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb add} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb add} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb select 2} {[-]*[0-9]+}} {0 {.nb delete select end} {}} {0 {.nb delete 0 end} {}} {0 {.nb add -label "First Page"} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb add -label "Second Page"} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb add -label "Third Page"} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb add -label "Fourth Page"} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb add -label "Fifth Page"} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb add -label "Sixth Page"} {[.]nb[.]cs[.]page[0-9]+[.]cs}} {0 {.nb select "First Page"} {[-]*[0-9]+}} {0 {.nb delete select "Second Page"} {}} {0 {.nb delete "Third Page" 1} {}} {0 {.nb delete "Fifth Page" "Sixth Page"} {}} } { 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 Notebook-3.$m "\[$method_invoke\]" $testContents \ [list $method_status 1] update incr m } # # Method tests which fail and produce errors # set m 1 foreach test { {1 {.nb delete 0 end} {can't delete page}} {1 {.nb childsite 0} {can't get childsite, no pages}} {0 {.nb add} {}} {1 {.nb childsite 1} {bad Notebook page index in childsite method}} {1 {.nb childsite -1} {bad Notebook page index in childsite method}} {0 {.nb delete 0} {}} {1 {.nb delete 0} {can't delete page, no pages}} {0 {.nb add} {}} {1 {.nb delete 1} {bad Notebook page index in delete method:}} {1 {.nb delete select} {bad Notebook page index in delete method:}} {0 {.nb delete 0} {}} {0 {.nb add} {}} {1 {.nb delete 0 1} {bad Notebook page index2 in delete method:}} {1 {.nb delete 1 4} {bad Notebook page index1 in delete method:}} {0 {.nb add} {}} {1 {.nb delete 1 0} {bad Notebook page index1 in delete method: index1 is greater than index2}} {0 {.nb delete 0 1} {}} {0 {.nb add} {}} {1 {.nb delete 0 1 4 5 6} {wrong # args}} {1 {.nb delete} {wrong # args}} {0 {.nb delete 0} {}} {1 {.nb delete 0} {can't delete page}} {1 {.nb delete select} {can't delete page}} {1 {.nb insert 0} {can't insert page}} {0 {.nb add} {}} {0 {.nb add} {}} {1 {.nb insert 2} {bad Notebook page index in insert method:}} {1 {.nb insert -1} {bad Notebook page index}} {0 {.nb delete 0 end} {}} {1 {.nb next} {can't move to next page, no pages in the notebook}} {1 {.nb prev} {can't move to previous page, no pages in the notebook}} {1 {.nb select 0} {can't select page}} {0 {.nb add} {}} {1 {.nb select 1} {bad Notebook page index in select method:}} {0 {.nb delete 0} {}} } { 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 Notebook-4.$m "\[$method_invoke\]" $testContents \ [list $method_status 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 } {} ::tcltest::cleanupTests exit