# This file is a Tcl script to test out [incr Widgets] Selectiondialog 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 # 4.x - Other 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: selectiondialog.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 Selectiondialog-1.$c {Selectiondialog construction} { iwidgets::Selectiondialog .sd .sd insert items end Hello {Out There} World .sd activate } {} incr c # # Option tests which are successful. # test Selectiondialog-2.$o {configuration option} { llength [.sd configure] } {44} incr o foreach test { {-width 340 340} {-width 360 360} {-activerelief raised raised} {-borderwidth 2 2} {-background #d9d9d9 #d9d9d9} {-buttonboxpos n n} {-buttonboxpadx 10 10} {-buttonboxpos e e} {-buttonboxpos w w} {-buttonboxpady 10 10} {-buttonboxpos s s} {-cursor gumby gumby} {-foreground Black Black} {-highlightcolor Black Black} {-highlightthickness 2 2} {-modality global global} {-modality application application} {-modality none none} {-padx 15 15} {-pady 15 15} {-textbackground GhostWhite GhostWhite} {-separator off off} {-thickness 4 4} {-separator on on} {-title Selectiondialog Selectiondialog} {-childsitepos n n} {-childsitepos s s} {-childsitepos e e} {-childsitepos w w} {-childsitepos center center} {-cursor gumby gumby} {-exportselection 0 0} {-insertbackground Blue Blue} {-insertbackground Black Black} {-insertborderwidth 1 1} {-insertofftime 200 200} {-insertontime 500 500} {-insertwidth 3 3} {-itemslabel "Items Label" "Items Label"} {-itemson no no} {-labelfont 6x13 6x13} {-itemson yes yes} {-selectbackground #c3c3c3 #c3c3c3} {-selectborderwidth 2 2} {-selectforeground Black Black} {-selectionlabel "Selection Label" "Selection Label"} {-selectionon no no} {-selectionon yes yes} {-width 0 0} {-height 0 0} {-textfont 6x13 6x13}} { set option [lindex $test 0] test Selectiondialog-2.$o "configuration options, $option" { .sd configure $option [lindex $test 1] lindex [.sd configure $option] 4 } [lindex $test 2] update incr o } # # Method tests which are successful. # foreach test { {{.sd childsite} {.sd.shellchildsite.dschildsite.selectionbox.sbchildsite}} {{.sd clear items} {}} {{.sd component selectionbox component items get 0 end} {}} {{.sd insert items 0 One Two Three Four Five Six} {}} {{.sd component selectionbox component items get 0 end} {One Two Three Four Five Six}} {{.sd size} 6} {{.sd clear selection} {}} {{.sd insert selection 0 One} {}} {{.sd get} One} {{.sd index end} 6} {{.sd index Six} 5} {{.sd selection set 1} {}} {{.sd selectitem} {}} {{.sd curselection} 1} {{.sd get} Two} {{.sd delete Three} {}} {{.sd clear items} {}} {{.sd hide Help} {}} {{.sd hide Cancel} {}} {{.sd default Apply} {}} {{.sd show Cancel} {}} {{.sd deactivate} {}}} { set method [lindex [lindex $test 0] 1] test Selectiondialog-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 { {{.sd clear bogus} {bad clear argument "bogus": should be selection or items}} {{.sd insert bogus bogus} {bad insert argument "bogus": should be selection or items}}} { set method [lindex [lindex $test 0] 1] test Selectiondialog-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 Selectiondialog-1.$c {Selectiondialog destruction} { destroy .sd update } {} incr c test Selectiondialog-1.$c {Selectiondialog construction} { iwidgets::selectiondialog .sd update } {} incr c test Selectiondialog-1.$c {Selectiondialog destruction} { destroy .sd update } {} incr c test Selectiondialog-1.$c {Selectiondialog destruction} { iwidgets::selectiondialog .sd destroy .sd update } {} ::tcltest::cleanupTests exit