1# This file is a Tcl script to test out [incr Widgets] Messagebox 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: messagebox.test,v 1.3 2001/08/07 19:56:48 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 Messagebox-1.$c {Messagebox construction} { 46 iwidgets::Messagebox .mb 47 pack .mb -padx 10 -pady 10 -fill both -expand yes 48 update 49} {} 50 51incr c 52 53# 54# Option tests which are successful. 55# 56test Messagebox-2.$o {configuration option} { 57 llength [.mb configure] 58} {40} 59 60incr o 61 62foreach test { 63 {-activebackground #ececec #ececec} 64 {-activeforeground Black Black} 65 {-background #d9d9d9 #d9d9d9} 66 {-borderwidth 3 3} 67 {-cursor gumby gumby} 68 {-exportselection 0 0} 69 {-exportselection 1 1} 70 {-filename /tmp/foo /tmp/foo} 71 {-foreground Black Black} 72 {-height 0 0} 73 {-width 0 0} 74 {-width 550 550} 75 {-height 120 120} 76 {-highlightcolor Black Black} 77 {-highlightthickness 2 2} 78 {-labelmargin 5 5} 79 {-labeltext Label Label} 80 {-labelpos nw nw} 81 {-labelpos ne ne} 82 {-labelpos en en} 83 {-labelpos e e} 84 {-labelpos es es} 85 {-labelpos se se} 86 {-labelpos s s} 87 {-labelpos sw sw} 88 {-labelpos wn wn} 89 {-labelpos w w} 90 {-labelpos ws ws} 91 {-labelpos n n} 92 {-relief raised raised} 93 {-relief sunken sunken} 94 {-vscrollmode none none} 95 {-vscrollmode static static} 96 {-vscrollmode dynamic dynamic} 97 {-hscrollmode none none} 98 {-hscrollmode static static} 99 {-hscrollmode dynamic dynamic} 100 {-maxlines 1200 1200} 101 {-sbwidth 20 20} 102 {-savedir /tmp /tmp} 103 {-scrollmargin 5 5} 104 {-textbackground GhostWhite GhostWhite}} { 105 set option [lindex $test 0] 106 test Messagebox-2.$o "configuration options, $option" { 107 .mb configure $option [lindex $test 1] 108 lindex [.mb configure $option] 4 109 } [lindex $test 2] 110 update 111 incr o 112} 113 114# 115# Option tests which fail and produce errors. 116# 117foreach test { 118 {-visibleitems bogus {bad visibleitems option "bogus": should be widthxheight}} 119 {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}} 120 {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}}} { 121 set option [lindex $test 0] 122 test Messagebox-2.$o "configuration options, $option" { 123 list [catch {.mb configure $option [lindex $test 1]} msg] $msg 124 } [list 1 [lindex $test 2]] 125 incr o 126} 127 128# 129# Method tests which are successful. 130# 131foreach test { 132 {{.mb issue "Default test"} {}} 133 {{.mb type add ERROR -background red -foreground white -bell 1} {ERROR}} 134 {{.mb issue "ERROR test" ERROR} {}} 135 {{.mb type configure ERROR -font 7x13 -show 0} {}} 136 {{.mb issue "ERROR test" ERROR} {}} 137 {{.mb type cget ERROR -background} {red}} 138 {{.mb type remove ERROR} {}} 139 {{.mb clear} {}}} { 140 set method [lindex [lindex $test 0] 1] 141 test Messagebox-3.$m "object methods, $method" { 142 list [catch {eval [lindex $test 0]} msg] $msg 143 } [list 0 [lindex $test 1]] 144 update 145 incr m 146} 147 148# 149# Method tests which fail and produce errors 150# 151foreach test { 152 {{.mb type bogus bogus} {bad type operation: "bogus", should be add, remove, configure or cget}} 153 {{.mb issue foo bogus} {bad message type: "bogus", use the type command to create a new types}}} { 154 set method [lindex [lindex $test 0] 1] 155 test Messagebox-3.$m "object methods, $method" { 156 list [catch {eval [lindex $test 0]} msg] $msg 157 } [list 1 [lindex $test 1]] 158 incr m 159} 160 161# 162# Conclusion of constrcution/destruction tests 163# 164test Messagebox-1.$c {Messagebox destruction} { 165 destroy .mb 166 update 167} {} 168 169incr c 170 171test Messagebox-1.$c {Messagebox construction} { 172 iwidgets::messagebox .mb -hscrollmode dynamic -labeltext "Label" \ 173 -labelpos n -labelmargin 5 174 pack .mb -padx 10 -pady 10 -fill both -expand yes 175 update 176} {} 177 178incr c 179 180test Messagebox-1.$c {Messagebox destruction} { 181 destroy .mb 182 update 183} {} 184 185incr c 186 187test Messagebox-1.$c {Messagebox destruction} { 188 iwidgets::messagebox .mb 189 pack .mb 190 destroy .mb 191 update 192} {} 193 194::tcltest::cleanupTests 195exit 196