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: scrolledcanvas.test,v 1.4 2001/08/22 19:08:32 smithc 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 Scrolledcanvas-1.$c {Scrolledcanvas construction} { 46 iwidgets::Scrolledcanvas .sc 47 pack .sc -padx 10 -pady 10 -fill both -expand yes 48 update 49} {} 50 51incr c 52 53# 54# Option tests which are successful. 55# 56test Scrolledcanvas-2.$o {configuration option} { 57 llength [.sc configure] 58} {45} 59 60incr o 61 62foreach test { 63 {-automargin 15 15} 64 {-autoresize 0 0} 65 {-autoresize 1 1} 66 {-background #d9d9d9 #d9d9d9} 67 {-borderwidth 2 2} 68 {-closeenough 1.0 1.0} 69 {-confine 1 1} 70 {-cursor gumby gumby} 71 {-height 200 200} 72 {-hscrollmode none none} 73 {-hscrollmode static static} 74 {-hscrollmode dynamic dynamic} 75 {-labelfont 6x13 6x13} 76 {-labeltext scrolledcanvas scrolledcanvas} 77 {-labelmargin 3 3} 78 {-labelpos nw nw} 79 {-labelpos ne ne} 80 {-labelpos en en} 81 {-labelpos e e} 82 {-labelpos es es} 83 {-labelpos se se} 84 {-labelpos s s} 85 {-labelpos sw sw} 86 {-labelpos wn wn} 87 {-labelpos w w} 88 {-labelpos ws ws} 89 {-labelpos n n} 90 {-relief raised raised} 91 {-relief sunken sunken} 92 {-sbwidth 15 15} 93 {-xscrollincrement 10 10} 94 {-yscrollincrement 10 10} 95 {-scrollmargin 3 3} 96 {-scrollregion {0 0 0 0} {0 0 0 0}} 97 {-sticky w w} 98 {-sticky nw nw} 99 {-sticky n n} 100 {-sticky ne ne} 101 {-sticky e e} 102 {-sticky se se} 103 {-sticky s s} 104 {-sticky sw sw} 105 {-sticky news news} 106 {-textbackground GhostWhite GhostWhite} 107 {-vscrollmode static static} 108 {-vscrollmode none none} 109 {-vscrollmode dynamic dynamic} 110 {-width 200 200}} { 111 set option [lindex $test 0] 112 test Scrolledcanvas-2.$o "configuration options, $option" { 113 .sc configure $option [lindex $test 1] 114 lindex [.sc 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 {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}} 125 {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}}} { 126 set option [lindex $test 0] 127 test Scrolledcanvas-2.$o "configuration options, $option" { 128 list [catch {.sc configure $option [lindex $test 1]} msg] $msg 129 } [list 1 [lindex $test 2]] 130 incr o 131} 132 133# 134# Method tests which are successful. 135# 136foreach test { 137 {{.sc create rectangle 100 100 400 400 -fill red} {1}} 138 {{.sc create rectangle 300 300 600 600 -fill green} {2}} 139 {{.sc create rectangle 200 200 500 500 -fill blue} {3}} 140 {{.sc bbox 1} {99 99 401 401}} 141 {{.sc coords 2} {300.0 300.0 600.0 600.0}} 142 {{.sc delete 3} {}} 143 {{.sc move 1 10 10} {}} 144 {{.sc scale 1 100 100 0.8 0.8} {}} 145 {{.sc xview moveto 0} {}} 146 {{.sc yview moveto 0} {}} 147 {{.sc childsite} {.sc.lwchildsite.clipper.canvas}} 148 {{.sc justify left} {}} 149 {{.sc justify right} {}} 150 {{.sc justify top} {}} 151 {{.sc justify bottom} {}}} { 152 set method [lindex [lindex $test 0] 1] 153 test Scrolledcanvas-3.$m "object methods, $method" { 154 list [catch {eval [lindex $test 0]} msg] $msg 155 } [list 0 [lindex $test 1]] 156 update 157 incr m 158} 159 160# 161# Conclusion of constrcution/destruction tests 162# 163test Scrolledcanvas-1.$c {Scrolledcanvas destruction} { 164 destroy .sc 165 update 166} {} 167 168incr c 169 170test Scrolledcanvas-1.$c {Scrolledcanvas construction} { 171 iwidgets::Scrolledcanvas .sc -autoresize no -labelpos nw \ 172 -vscrollmode static -hscrollmode dynamic -labeltext "Scrolledcanvas" 173 pack .sc -padx 10 -pady 10 -fill both -expand yes 174 update 175} {} 176 177incr c 178 179test Scrolledcanvas-1.$c {Scrolledcanvas destruction} { 180 destroy .sc 181 update 182} {} 183 184incr c 185 186test Scrolledcanvas-1.$c {Scrolledcanvas destruction} { 187 iwidgets::scrolledcanvas .sc 188 pack .sc 189 destroy .sc 190 update 191} {} 192 193::tcltest::cleanupTests 194exit 195