1# This file is a Tcl script to test out [incr Widgets] Optionmenu 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: optionmenu.test,v 1.6 2001/08/22 20:23:36 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 Optionmenu-1.$c {Optionmenu construction} { 46 iwidgets::Optionmenu .om 47 pack .om -padx 10 -pady 10 -fill both -expand yes 48 update 49} {} 50 51incr c 52 53# 54# Option tests which are successful. 55# 56test Optionmenu-2.$o {configuration option} { 57 llength [.om configure] 58} {27} 59 60incr o 61 62foreach test { 63 {-activebackground #ececec #ececec} 64 {-activeborderwidth 2 2} 65 {-activeforeground Black Black} 66 {-labeltext Optionmenu Optionmenu} 67 {-background #d9d9d9 #d9d9d9} 68 {-borderwidth 2 2} 69 {-labelpos w w} 70 {-clicktime 100 100} 71 {-command {.om configure -background Red} {.om configure -background Red}} 72 {-cursor gumby gumby} 73 {-labelpos nw nw} 74 {-cyclicon false false} 75 {-cyclicon true true} 76 {-font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*} 77 {-labelpos n n} 78 {-foreground Black Black} 79 {-labelpos ne ne} 80 {-labelpos se se} 81 {-labelfont -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*} 82 {-labelmargin 5 5} 83 {-labelpos e e} 84 {-state disabled disabled} 85 {-labelpos s s} 86 {-state normal normal} 87 {-labelpos sw sw} 88 {-labelpos w w} 89 {-sticky w w} 90 {-sticky nw nw} 91 {-sticky n n} 92 {-sticky ne ne} 93 {-sticky e e} 94 {-sticky se se} 95 {-sticky s s} 96 {-sticky sw sw} 97 {-sticky news news} 98 {-width 140 140}} { 99 set option [lindex $test 0] 100 test Optionmenu-2.$o "configuration options, $option" { 101 .om configure $option [lindex $test 1] 102 lindex [.om configure $option] 4 103 } [lindex $test 2] 104 update 105 incr o 106} 107 108# 109# Option tests which fail and produce errors. 110# 111foreach test { 112 {-state bogus {bad state option "bogus": should be disabled or normal}}} { 113 set option [lindex $test 0] 114 test Optionmenu-2.$o "configuration options, $option" { 115 list [catch {.om configure $option [lindex $test 1]} msg] $msg 116 } [list 1 [lindex $test 2]] 117 incr o 118} 119 120# 121# Method tests which are successful. 122# 123foreach test { 124 {{.om index 0} 0} 125 {{.om insert end Unix VMS Linux OS/2 {Windows NT} DOS} {}} 126 {{.om index end} 5} 127 {{.om index select} 0} 128 {{.om index OS/2} 3} 129 {{.om delete 0 1} {}} 130 {{.om delete OS/2} {}} 131 {{.om disable 0} {}} 132 {{.om enable 0} {}} 133 {{.om disable DOS} {}} 134 {{.om enable DOS} {}} 135 {{.om select Linux} {}} 136 {{.om get} Linux} 137 {{.om get 1} {Windows NT}} 138 {{.om get 0 end} {Linux {Windows NT} DOS}} 139 {{.om insert 0 Unix VMS} {}} 140 {{.om select 3} {}} 141 {{.om select end} {}} 142 {{.om sort ascending} {}} 143 {{.om sort descending} {}} 144 {{.om sort increasing} {}} 145 {{.om sort decreasing} {}}} { 146 set method [lindex [lindex $test 0] 1] 147 test Optionmenu-3.$m "object methods, $method" { 148 list [catch {eval [lindex $test 0]} msg] $msg 149 } [list 0 [lindex $test 1]] 150 update 151 incr m 152} 153 154# 155# Method tests which fail and produce errors 156# 157foreach test { 158 {{.om index bogus} {bad Optionmenu index "bogus"}} 159 {{.om sort bogus} {bad sort argument "bogus": should be ascending, descending, increasing, or decreasing}}} { 160 set method [lindex [lindex $test 0] 1] 161 test Optionmenu-3.$m "object methods, $method" { 162 list [catch {eval [lindex $test 0]} msg] $msg 163 } [list 1 [lindex $test 1]] 164 incr m 165} 166 167# 168# Conclusion of constrcution/destruction tests 169# 170test Optionmenu-1.$c {Optionmenu destruction} { 171 destroy .om 172 update 173} {} 174 175incr c 176 177test Optionmenu-1.$c {Optionmenu construction} { 178 iwidgets::optionmenu .om -labeltext "Label" \ 179 -labelpos n 180 pack .om -padx 10 -pady 10 -fill both -expand yes 181 update 182} {} 183 184incr c 185 186test Optionmenu-1.$c {Optionmenu destruction} { 187 destroy .om 188 update 189} {} 190 191incr c 192 193test Optionmenu-1.$c {Optionmenu destruction} { 194 iwidgets::optionmenu .om 195 pack .om 196 destroy .om 197 update 198} {} 199 200::tcltest::cleanupTests 201exit 202