1# This file is a Tcl script to test out [incr Widgets] Scrolledlistbox class. 2# It is organized in the standard fashion for Tcl tests with the following 3# notation for test case labels: 4# 5# 1.x - Construction/Destruction tests 6# 2.x - Configuration option tests 7# 3.x - Method tests 8# 9# Copyright (c) 1995 DSC Technologies Corporation 10# 11# See the file "license.terms" for information on usage and redistribution 12# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 13# 14# @(#) $Id: scrolledlistbox.test,v 1.5 2002/03/16 16:27:33 mgbacke Exp $ 15 16package require tcltest 17namespace import -force ::tcltest::* 18 19if [catch {package require Iwidgets 4.0}] { 20 # Let's try modifying the auto_path. Note that the IWIDGETS_LIBRARY 21 # env var is initialized in the Makefile when doing a 'make test'. 22 # If sourcing this file independently, this variable must be set manually. 23 if ![info exists env(IWIDGETS_LIBRARY)] { 24 error "Unable to locate Iwidgets package. Set your IWIDGETS_LIBRARY\ 25 environment\nvariable to the directory that contains iwidgets.tcl" 26 } 27 lappend auto_path $env(IWIDGETS_LIBRARY) 28 package require Iwidgets 4.0 29} 30 31if {[string compare test [info procs test]] == 1} { 32 source defs 33} 34 35wm geometry . {} 36raise . 37 38set c 1 39set o 1 40set m 1 41 42# 43# Initial construction test 44# 45test Scrolledlistbox-1.$c {Scrolledlistbox construction} { 46 iwidgets::Scrolledlistbox .slb -height 300 -width 300 47 pack .slb -padx 10 -pady 10 -fill both -expand yes 48 .slb insert end {Hello World} {Hello World} 49 update 50} {} 51 52incr c 53 54# 55# Option tests which are successful. 56# 57test Scrolledlistbox-2.$o {configuration option} { 58 llength [.slb configure] 59} {40} 60 61incr o 62 63foreach test { 64 {-labeltext Scrolledlistbox Scrolledlistbox} 65 {-height 200 200} 66 {-width 200 200} 67 {-labelpos nw nw} 68 {-labelpos ne ne} 69 {-labelpos en en} 70 {-labelpos e e} 71 {-labelpos es es} 72 {-labelpos se se} 73 {-labelpos s s} 74 {-labelpos sw sw} 75 {-labelpos wn wn} 76 {-labelpos w w} 77 {-labelpos ws ws} 78 {-labelpos n n} 79 {-borderwidth 3 3} 80 {-hscrollmode none none} 81 {-hscrollmode static static} 82 {-hscrollmode dynamic dynamic} 83 {-relief raised raised} 84 {-relief sunken sunken} 85 {-sbwidth 20 20} 86 {-sbwidth 15 15} 87 {-textbackground GhostWhite GhostWhite} 88 {-scrollmargin 10 10} 89 {-selectborderwidth 3 3} 90 {-selectforeground blue blue} 91 {-selectmode browse browse} 92 {-selectmode extended extended} 93 {-selectmode single single} 94 {-selectmode multiple multiple} 95 {-sticky w w} 96 {-sticky nw nw} 97 {-sticky n n} 98 {-sticky ne ne} 99 {-sticky e e} 100 {-sticky se se} 101 {-sticky s s} 102 {-sticky sw sw} 103 {-sticky news news} 104 {-textfont 6x13 6x13} 105 {-vscrollmode none none} 106 {-vscrollmode static static} 107 {-vscrollmode dynamic dynamic} 108 {-visibleitems 30x20 30x20} 109 {-width 0 0} 110 {-height 0 0}} { 111 set option [lindex $test 0] 112 test Scrolledlistbox-2.$o "configuration options, $option" { 113 .slb configure $option [lindex $test 1] 114 lindex [.slb configure $option] 4 115 } [lindex $test 2] 116 update 117 incr o 118} 119 120# 121# Option tests which fail and produce errors. 122# 123foreach test { 124 {-visibleitems bogus {bad visibleitems option "bogus": should be widthxheight}} 125 {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}} 126 {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}}} { 127 set option [lindex $test 0] 128 test Scrolledlistbox-2.$o "configuration options, $option" { 129 list [catch {.slb configure $option [lindex $test 1]} msg] $msg 130 } [list 1 [lindex $test 2]] 131 incr o 132} 133 134# 135# Method tests which are successful. 136# 137foreach test { 138 {{.slb insert 0 Test Test Test Test} {}} 139 {{.slb insert end {More Test}} {}} 140 {{.slb delete 1} {}} 141 {{.slb delete 0 3} {}} 142 {{.slb insert end World} {}} 143 {{.slb selection set World} {}} 144 {{.slb selection set World {More Test}} {}} 145 {{.slb getcurselection} {{More Test} World}} 146 {{.slb selecteditemcount} {2}} 147 {{.slb selection clear 0 end} {}} 148 {{.slb selecteditemcount} {0}} 149 {{.slb clear} {}} 150 {{.slb size} {0}} 151 {{.slb insert end {Test} {Test} {Long String Test}} {}} 152 {{.slb size} {3}} 153 {{.slb insert 0 {Test} {Test} {Long String Test}} {}} 154 {{.slb size} {6}} 155 {{.slb insert 1 {Test} {Test} {Long String Test}} {}} 156 {{.slb size} {9}} 157 {{.slb insert 5 {Test} {Test} {XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}} {}} 158 {{.slb size} {12}} 159 {{.slb get end} {Long String Test}} 160 {{.slb justify left} {}} 161 {{.slb justify right} {}} 162 {{.slb justify top} {}} 163 {{.slb justify bottom} {}} 164 {{.slb sort ascending} {}} 165 {{.slb sort descending} {}} 166 {{.slb sort increasing} {}} 167 {{.slb sort decreasing} {}}} { 168 set method [lindex [lindex $test 0] 1] 169 test Scrolledlistbox-3.$m "object methods, $method" { 170 list [catch {eval [lindex $test 0]} msg] $msg 171 } [list 0 [lindex $test 1]] 172 update 173 incr m 174} 175 176# 177# Method tests which fail and produce errors 178# 179foreach test { 180 {{.slb index bogus} {bad Scrolledlistbox index "bogus": must be active, anchor, end, @x,y, number, or a pattern}} 181 {{.slb justify bogus} {bad justify argument "bogus": should be left, right, top, or bottom}} 182 {{.slb sort bogus} {bad sort argument "bogus": must be a valid argument to the Tcl lsort command}}} { 183 184 set method [lindex [lindex $test 0] 1] 185 test Scrolledlistbox-3.$m "object methods, $method" { 186 list [catch {eval [lindex $test 0]} msg] $msg 187 } [list 1 [lindex $test 1]] 188 incr m 189} 190 191# 192# Conclusion of constrcution/destruction tests 193# 194test Scrolledlistbox-1.$c {Scrolledlistbox destruction} { 195 destroy .slb 196 update 197} {} 198 199incr c 200 201test Scrolledlistbox-1.$c {Scrolledlistbox construction} { 202 iwidgets::scrolledlistbox .slb -selectmode extended \ 203 -vscrollmode static -hscrollmode dynamic -labeltext "List" \ 204 -labelpos nw 205 pack .slb -padx 10 -pady 10 -fill both -expand yes 206 update 207} {} 208 209incr c 210 211test Scrolledlistbox-1.$c {Scrolledlistbox destruction} { 212 destroy .slb 213 update 214} {} 215 216incr c 217 218test Scrolledlistbox-1.$c {Scrolledlistbox destruction} { 219 iwidgets::scrolledlistbox .slb 220 pack .slb 221 destroy .slb 222 update 223} {} 224 225::tcltest::cleanupTests 226exit 227