# This file is a Tcl script to test out [incr Widgets] Buttonbox 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: buttonbox.test,v 1.3 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 Buttonbox-1.$c {Buttonbox construction} { iwidgets::Buttonbox .bb pack .bb update } {} incr c # # Button additions # test Buttonbox-1.$c {Buttonbox construction} { .bb add Yes -text Yes update .bb add No -text No update .bb default Yes update } {} incr c # # Option tests which are successful. # test Buttonbox-2.$o {configuration option} { llength [.bb configure] } {14} incr o foreach test { {-activebackground #ececec #ececec} {-activeforeground Black Black} {-orient vertical vertical} {-background #d9d9d9 #d9d9d9} {-cursor gumby gumby} {-disabledforeground #a3a3a3 #a3a3a3} {-foreground Black Black} {-highlightcolor Black Black} {-highlightthickness 2 2} {-orient horizontal horizontal} {-padx 10 10} {-pady 10 10}} { set option [lindex $test 0] test Buttonbox-2.$o "configuration options, $option" { .bb configure $option [lindex $test 1] lindex [.bb configure $option] 4 } [lindex $test 2] update incr o } # # Option tests which fail and produce errors. # foreach test { {-orient bogus {bad orientation option "bogus", should be either horizontal or vertical}}} { set option [lindex $test 0] test Buttonbox-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 { {{.bb index 0} {0}} {{.bb index end} {1}} {{.bb index default} {0}} {{.bb index No} {1}} {{.bb index Y*} {0}} {{.bb add Maybe -text Maybe} {}} {{.bb insert 0 Never -text Never} {}} {{.bb default Never} {}} {{.bb hide Yes} {}} {{.bb show Yes } {}} {{.bb hide end} {}} {{.bb show end} {}} {{.bb hide 1} {}} {{.bb show 1} {}} {{.bb hide N*} {}} {{.bb show N*} {}} {{.bb invoke Yes} {}} {{.bb invoke} {}} {{.bb invoke default} {}} {{.bb delete Maybe} {}} {{.bb buttonconfigure Yes -text YES} {}} {{.bb buttonconfigure N* -defaultring no} {}} {{.bb buttonconfigure end -defaultring true} {}}} { set method [lindex [lindex $test 0] 1] test Buttonbox-3.$m "object methods, $method" { 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 { {{.bb index 12} {Buttonbox index "12" is out of range}} {{.bb index bogus} {bad Buttonbox index "bogus": must be number, end, default, or pattern}}} { set method [lindex [lindex $test 0] 1] test Buttonbox-3.$m "object methods, $method" { list [catch {eval [lindex $test 0]} msg] $msg } [list 1 [lindex $test 1]] incr m } # # Conclusion of constrcution/destruction tests # test Buttonbox-1.$c {Buttonbox destruction} { destroy .bb update } {} incr c test Buttonbox-1.$c {Buttonbox construction} { iwidgets::buttonbox .bb pack .bb update .bb add Hello -text Hello update .bb insert end GoodBye -text GoodBye update .bb default Hello update .bb default GoodBye update } {} incr c test Buttonbox-1.$c {Buttonbox destruction} { destroy .bb update } {} incr c test Buttonbox-1.$c {Buttonbox destruction} { iwidgets::buttonbox .bb pack .bb destroy .bb update } {} ::tcltest::cleanupTests exit