# This file is a Tcl script to test out [incr Widgets] Tabnotebook 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: tabnotebook.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 Tabnotebook-1.$c {Tabnotebook construction} { iwidgets::Tabnotebook .tn pack .tn update .tn add -label one update .tn add -label two update .tn add -label three update } {} incr c # # Option tests which are successful. # test Tabnotebook-2.$o {configuration option} { llength [.tn configure] } {26} incr o foreach test { {-disabledforeground #a3a3a3 #a3a3a3 } {-start 4 4 } {-backdrop #d9d9d9 #d9d9d9 } {-borderwidth 2 2 } {-scrollcommand } {-font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* } {-gap overlap overlap } {-background #CDCDB7B7B5B5 #CDCDB7B7B5B5 } {-state normal normal } {-bevelamount 0 0 } {-equaltabs true true } {-foreground #000000000000 #000000000000 } {-raiseselect false false } {-padx 4 4 } {-pady 4 4 } {-margin 4 4 } {-cursor } {-angle 15 15 } {-tabbackground #d9d9d9 #d9d9d9 } {-tabborders true true } {-width 300 300 } {-tabpos s s } {-auto true true } {-height 150 150 } {-tabforeground Black Black } } { set option [lindex $test 0] test Tabnotebook-2.$o "configuration options, $option" { .tn configure $option [lindex $test 1] lindex [.tn configure $option] 4 } [lindex $test 2] update incr o } # # PageConfigure Option tests which are successful. # test Tabnotebook-2.$o {page configuration option} { llength [.tn pageconfigure 0] } {30} # 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 Tabnotebook-2.$o "configuration options, $option" { .tn pageconfigure $index $option [lindex $test 2] lindex [.tn 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 Tabnotebook-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 { {{.tn add} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn add} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn add} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn add -label Never} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn add} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn add -label "Hello World" -disabledforeground gray} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn childsite Never} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn childsite 0} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn childsite end} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn index end} {[0-9]+}} {{.tn index Never} {[0-9]+}} {{.tn index 0} {0}} {{.tn select 0} {0}} {{.tn select select} {}} {{.tn select end} {[0-9]+}} {{.tn select "Hello World"} {[0-9]+}} {{.tn insert 0} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn insert select -label "An Insert"} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn insert end -label "Next To Last"} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn select 0} {0}} {{.tn next} {1}} {{.tn next} {2}} {{.tn prev} {1}} {{.tn prev} {0}} {{.tn delete Never} {}} {{.tn delete 1 2} {}} {{.tn delete 0 "Hello World"} {}} {{.tn add} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn add} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn add} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn add} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn delete 0 end} {}} {{.tn add} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn add} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn add} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn add} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn select 2} {[-]*[0-9]+}} {{.tn delete select end} {}} {{.tn delete 0 end} {}} {{.tn add -label "First Page"} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn add -label "Second Page"} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn add -label "Third Page"} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn add -label "Fourth Page"} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn add -label "Fifth Page"} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn add -label "Sixth Page"} {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}} {{.tn select "First Page"} {[-]*[0-9]+}} {{.tn delete select "Second Page"} {}} {{.tn delete "Third Page" 1} {}} {{.tn delete "Fifth Page" "Sixth Page"} {}} } { set method [lindex [lindex $test 0] 1] set method_invoke [lindex $test 0] set testContents "set msg {}\n" append testContents \ "set result \[catch \{[lindex $test 0]\} msg\]\n" append testContents \ "lappend result \[regexp -- \{[lindex $test 1]\} \$msg\] \n" append testContents "set result\n" test Tabnotebook-3.$m "\[$method_invoke\]" $testContents \ [list 0 1] update incr m } # # Method tests which fail and produce errors # set m 1 foreach test { {1 {.tn delete 0 end} {can't delete page}} {1 {.tn childsite 0} {can't get childsite, no pages}} {0 {.tn add} {}} {1 {.tn childsite 1} {bad Notebook page index in childsite method}} {1 {.tn childsite -1} {bad Notebook page index in childsite method}} {0 {.tn delete 0} {}} {1 {.tn delete 0} {can't delete page, no pages}} {0 {.tn add} {}} {1 {.tn delete 1} {bad Notebook page index in delete method:}} {1 {.tn delete select} {bad Notebook page index in delete method:}} {0 {.tn delete 0} {}} {0 {.tn add} {}} {1 {.tn delete 0 1} {bad Notebook page index2 in delete method:}} {1 {.tn delete 1 4} {bad Notebook page index1 in delete method:}} {0 {.tn add} {}} {1 {.tn delete 1 0} {bad Notebook page index1 in delete method: index1 is greater than index2}} {0 {.tn delete 0 1} {}} {0 {.tn add} {}} {1 {.tn delete 0 1 4 5 6} {wrong # args}} {1 {.tn delete} {wrong # args}} {0 {.tn delete 0} {}} {1 {.tn delete 0} {can't delete page}} {1 {.tn delete select} {can't delete page}} {1 {.tn insert 0} {can't insert page}} {0 {.tn add} {}} {0 {.tn add} {}} {1 {.tn insert 2} {bad Notebook page index in insert method:}} {1 {.tn insert -1} {bad Notebook page index}} {0 {.tn delete 0 end} {}} {1 {.tn next} {can't move to next page, no pages in the notebook}} {1 {.tn prev} {can't move to previous page, no pages in the notebook}} {1 {.tn select 0} {can't select page}} {0 {.tn add} {}} {1 {.tn select 1} {bad Notebook page index in select method:}} {0 {.tn 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 Tabnotebook-4.$m "\[$method_invoke\]" $testContents \ [list $method_status 1] incr m } # Conclusion of constrcution/destruction tests # test Tabnotebook-1.$c {Tabnotebook destruction} { destroy .tn update } {} incr c test Tabnotebook-1.$c {Tabnotebook construction} { iwidgets::Tabnotebook .tn -width 100 -height 100 pack .tn update .tn add -label one update .tn add -label two update .tn add -label three update } {} incr c test Tabnotebook-1.$c {Tabnotebook destruction} { destroy .tn update } {} ::tcltest::cleanupTests exit