1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219
|
# This file is a Tcl script to test out [incr Widgets] Dateentry 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: dateentry.test,v 1.5 2001/11/16 15:28:03 smithc 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 Dateentry-1.$c {Dateentry construction} {
iwidgets::Dateentry .de -labeltext "Date Field"
pack .de -padx 10 -pady 10 -fill both -expand yes
update
} {}
incr c
#
# Option tests which are successful.
#
test Dateentry-2.$o {configuration option} {
llength [.de configure]
} {46}
incr o
foreach test {
{-background #d9d9d9 #d9d9d9}
{-buttonforeground green green}
{-borderwidth 4 4}
{-borderwidth 2 2}
{-command {.de configure -background red} {.de configure -background red}}
{-cursor gumby gumby}
{-exportselection 0 0}
{-foreground Green Green}
{-foreground Black Black}
{-gmt true true}
{-gmt false false}
{-gmt on on}
{-gmt off off}
{-gmt 1 1}
{-gmt 0 0}
{-gmt yes yes}
{-gmt no no}
{-highlightcolor Red Red}
{-highlightthickness 2 2}
{-insertbackground Yellow Yellow}
{-insertbackground Black Black}
{-int yes yes}
{-int no no}
{-iq low low}
{-iq average average}
{-iq high high}
{-justify right right}
{-justify center center}
{-justify left left}
{-labelmargin 5 5}
{-labelpos w w}
{-labelpos nw nw}
{-labelpos n n}
{-labelpos ne ne}
{-labelpos e e}
{-labelpos se se}
{-labelpos s s}
{-labelpos sw sw}
{-labeltext Label Label}
{-relief raised raised}
{-relief sunken sunken}
{-currentdatefont -*-helvetica-bold-r-normal--*-120-* -*-helvetica-bold-r-normal--*-120-*}
{-datefont -*-helvetica-medium-r-normal--*-120-* -*-helvetica-medium-r-normal--*-120-*}
{-dayfont -*-helvetica-medium-r-normal--*-120-* -*-helvetica-medium-r-normal--*-120-*}
{-days {M T W T F S S} {M T W T F S S}}
{-foreground black black}
{-height 300 300}
{-outline black black}
{-selectcolor blue blue}
{-selectthickness 2 2}
{-startday monday monday}
{-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}
{-titlefont -*-helvetica-bold-r-normal--*-140-* -*-helvetica-bold-r-normal--*-140-*}
{-weekdaybackground mistyrose mistyrose}
{-weekendbackground white white}
{-width 350 350}
{-textbackground GhostWhite GhostWhite}
{-textbackground #d9d9d9 #d9d9d9}} {
set option [lindex $test 0]
test Dateentry-2.$o "configuration options, $option" {
.de configure $option [lindex $test 1]
lindex [.de configure $option] 4
} [lindex $test 2]
update
incr o
}
#
# Option tests which fail and produce errors.
#
foreach test {
{-iq bogus {bad iq option "bogus": should be high, average or low}}
{-gmt bogus {bad gmt option "bogus": should be boolean}}
{-childsitepos bogus {bad childsite option "bogus": should be n, e, s, or w}}} {
set option [lindex $test 0]
test Dateentry-2.$o "configuration options, $option" {
list [catch {.de configure $option [lindex $test 1]} msg] $msg
} [list 1 [lindex $test 2]]
incr o
}
#
# Method tests which are successful.
#
foreach test {
{{.de childsite} {.de.lwchildsite}}
{{.de show 03/03/1960} {}}
{{.de get} {03/03/1960}}
{{.de get -string} {03/03/1960}}
{{.de isvalid} {1}}
{{.de component date delete 0 end} {}}
{{.de component date insert end 03/32/1960} {}}
{{.de isvalid} {0}}
{{.de show 03/03/1960} {}}
{{.de show now} {}}} {
set method [lindex [lindex $test 0] 1]
test Dateentry-3.$m "object methods, $method" {
list [catch {eval [lindex $test 0]} msg] $msg
} [list 0 [lindex $test 1]]
update
incr m
}
test Dateentry-3.$m "object methods, clock clicks" {
set clicks [clock scan "06/08/1964"]
.de show $clicks
update
.de get
} {06/08/1964}
incr m
#
# Method tests which fail and produce errors
#
foreach test {
{{.de get bogus} {bad format option "bogus": should be -string or -clicks}}
{{.de show bogus} {bad date: "bogus", must be a valid date string, clock clicks value or the keyword now}}} {
set method [lindex [lindex $test 0] 1]
test Dateentry-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 Dateentry-1.$c {Dateentry destruction} {
destroy .de
update
} {}
incr c
test Dateentry-1.$c {Dateentry construction} {
iwidgets::dateentry .de
pack .de -padx 10 -pady 10
update
} {}
incr c
test Dateentry-1.$c {Dateentry destruction} {
destroy .de
update
} {}
::tcltest::cleanupTests
exit
|