# This file is a Tcl script to test out [incr Widgets] Scrolledlistbox 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: scrolledlistbox.test,v 1.5 2002/03/16 16:27:33 mgbacke 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 Scrolledlistbox-1.$c {Scrolledlistbox construction} { iwidgets::Scrolledlistbox .slb -height 300 -width 300 pack .slb -padx 10 -pady 10 -fill both -expand yes .slb insert end {Hello World} {Hello World} update } {} incr c # # Option tests which are successful. # test Scrolledlistbox-2.$o {configuration option} { llength [.slb configure] } {40} incr o foreach test { {-labeltext Scrolledlistbox Scrolledlistbox} {-height 200 200} {-width 200 200} {-labelpos nw nw} {-labelpos ne ne} {-labelpos en en} {-labelpos e e} {-labelpos es es} {-labelpos se se} {-labelpos s s} {-labelpos sw sw} {-labelpos wn wn} {-labelpos w w} {-labelpos ws ws} {-labelpos n n} {-borderwidth 3 3} {-hscrollmode none none} {-hscrollmode static static} {-hscrollmode dynamic dynamic} {-relief raised raised} {-relief sunken sunken} {-sbwidth 20 20} {-sbwidth 15 15} {-textbackground GhostWhite GhostWhite} {-scrollmargin 10 10} {-selectborderwidth 3 3} {-selectforeground blue blue} {-selectmode browse browse} {-selectmode extended extended} {-selectmode single single} {-selectmode multiple multiple} {-sticky w w} {-sticky nw nw} {-sticky n n} {-sticky ne ne} {-sticky e e} {-sticky se se} {-sticky s s} {-sticky sw sw} {-sticky news news} {-textfont 6x13 6x13} {-vscrollmode none none} {-vscrollmode static static} {-vscrollmode dynamic dynamic} {-visibleitems 30x20 30x20} {-width 0 0} {-height 0 0}} { set option [lindex $test 0] test Scrolledlistbox-2.$o "configuration options, $option" { .slb configure $option [lindex $test 1] lindex [.slb configure $option] 4 } [lindex $test 2] update incr o } # # Option tests which fail and produce errors. # foreach test { {-visibleitems bogus {bad visibleitems option "bogus": should be widthxheight}} {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}} {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}}} { set option [lindex $test 0] test Scrolledlistbox-2.$o "configuration options, $option" { list [catch {.slb configure $option [lindex $test 1]} msg] $msg } [list 1 [lindex $test 2]] incr o } # # Method tests which are successful. # foreach test { {{.slb insert 0 Test Test Test Test} {}} {{.slb insert end {More Test}} {}} {{.slb delete 1} {}} {{.slb delete 0 3} {}} {{.slb insert end World} {}} {{.slb selection set World} {}} {{.slb selection set World {More Test}} {}} {{.slb getcurselection} {{More Test} World}} {{.slb selecteditemcount} {2}} {{.slb selection clear 0 end} {}} {{.slb selecteditemcount} {0}} {{.slb clear} {}} {{.slb size} {0}} {{.slb insert end {Test} {Test} {Long String Test}} {}} {{.slb size} {3}} {{.slb insert 0 {Test} {Test} {Long String Test}} {}} {{.slb size} {6}} {{.slb insert 1 {Test} {Test} {Long String Test}} {}} {{.slb size} {9}} {{.slb insert 5 {Test} {Test} {XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}} {}} {{.slb size} {12}} {{.slb get end} {Long String Test}} {{.slb justify left} {}} {{.slb justify right} {}} {{.slb justify top} {}} {{.slb justify bottom} {}} {{.slb sort ascending} {}} {{.slb sort descending} {}} {{.slb sort increasing} {}} {{.slb sort decreasing} {}}} { set method [lindex [lindex $test 0] 1] test Scrolledlistbox-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 { {{.slb index bogus} {bad Scrolledlistbox index "bogus": must be active, anchor, end, @x,y, number, or a pattern}} {{.slb justify bogus} {bad justify argument "bogus": should be left, right, top, or bottom}} {{.slb sort bogus} {bad sort argument "bogus": must be a valid argument to the Tcl lsort command}}} { set method [lindex [lindex $test 0] 1] test Scrolledlistbox-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 Scrolledlistbox-1.$c {Scrolledlistbox destruction} { destroy .slb update } {} incr c test Scrolledlistbox-1.$c {Scrolledlistbox construction} { iwidgets::scrolledlistbox .slb -selectmode extended \ -vscrollmode static -hscrollmode dynamic -labeltext "List" \ -labelpos nw pack .slb -padx 10 -pady 10 -fill both -expand yes update } {} incr c test Scrolledlistbox-1.$c {Scrolledlistbox destruction} { destroy .slb update } {} incr c test Scrolledlistbox-1.$c {Scrolledlistbox destruction} { iwidgets::scrolledlistbox .slb pack .slb destroy .slb update } {} ::tcltest::cleanupTests exit