1# This file is a Tcl script to test out [incr Widgets] Calendar 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: calendar.test,v 1.4 2001/11/16 15:28:03 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 Calendar-1.$c {Calendar construction} { 46 iwidgets::Calendar .cal 47 pack .cal -padx 10 -pady 10 -fill both -expand yes 48 update 49} {} 50 51incr c 52 53# 54# Option tests which are successful. 55# 56test Calendar-2.$o {configuration option} { 57 llength [.cal configure] 58} {22} 59 60incr o 61 62foreach test { 63 {-background #d9d9d9 #d9d9d9} 64 {-buttonforeground green green} 65 {-command {.cal configure -background red} {.cal configure -background red}} 66 {-currentdatefont -*-helvetica-bold-r-normal--*-120-* -*-helvetica-bold-r-normal--*-120-*} 67 {-cursor gumby gumby} 68 {-datefont -*-helvetica-medium-r-normal--*-120-* -*-helvetica-medium-r-normal--*-120-*} 69 {-dayfont -*-helvetica-medium-r-normal--*-120-* -*-helvetica-medium-r-normal--*-120-*} 70 {-days {M T W T F S S} {M T W T F S S}} 71 {-foreground black black} 72 {-height 300 300} 73 {-int yes yes} 74 {-int no no} 75 {-outline black black} 76 {-selectcolor blue blue} 77 {-selectthickness 2 2} 78 {-startday monday monday} 79 {-titlefont -*-helvetica-bold-r-normal--*-140-* -*-helvetica-bold-r-normal--*-140-*} 80 {-weekdaybackground mistyrose mistyrose} 81 {-weekendbackground white white} 82 {-width 350 350}} { 83 set option [lindex $test 0] 84 test Calendar-2.$o "configuration options, $option" { 85 .cal configure $option [lindex $test 1] 86 lindex [.cal configure $option] 4 87 } [lindex $test 2] 88 update 89 incr o 90} 91 92# 93# Option tests which fail and produce errors. 94# 95foreach test { 96 {-backwardimage bogus {bad image name "bogus": image does not exist}} 97 {-forwardimage bogus {bad image name "bogus": image does not exist}} 98 {-startday bogus {bad startday option "bogus": should be sunday, monday, tuesday, wednesday, thursday, friday, or saturday}}} { 99 set option [lindex $test 0] 100 test Calendar-2.$o "configuration options, $option" { 101 list [catch {.cal configure $option [lindex $test 1]} msg] $msg 102 } [list 1 [lindex $test 2]] 103 incr o 104} 105 106# 107# Method tests which are successful. 108# 109foreach test { 110 {{.cal select 03/03/1960} {}} 111 {{.cal get} {03/03/1960}} 112 {{.cal show 03/03/1960} {}} 113 {{.cal get -string} {03/03/1960}} 114 {{.cal select now} {}} 115 {{.cal show now} {}}} { 116 set method [lindex [lindex $test 0] 1] 117 test Calendar-3.$m "object methods, $method" { 118 list [catch {eval [lindex $test 0]} msg] $msg 119 } [list 0 [lindex $test 1]] 120 update 121 incr m 122} 123 124test Calendar-3.$m "object methods, clock clicks" { 125 set clicks [clock scan "06/08/1964"] 126 .cal show $clicks 127 .cal select $clicks 128 update 129 .cal get 130} {06/08/1964} 131incr m 132 133# 134# Method tests which fail and produce errors 135# 136foreach test { 137 {{.cal get bogus} {bad format option "bogus": should be -string or -clicks}} 138 {{.cal select bogus} {bad date: "bogus", must be a valid date string, clock clicks value or the keyword now}} 139 {{.cal show bogus} {bad date: "bogus", must be a valid date string, clock clicks value or the keyword now}}} { 140 set method [lindex [lindex $test 0] 1] 141 test Calendar-3.$m "object methods, $method" { 142 list [catch {eval [lindex $test 0]} msg] $msg 143 } [list 1 [lindex $test 1]] 144 incr m 145} 146 147# 148# Conclusion of constrcution/destruction tests 149# 150test Calendar-1.$c {Calendar destruction} { 151 destroy .cal 152 update 153} {} 154 155incr c 156 157test Calendar-1.$c {Calendar construction} { 158 iwidgets::calendar .cal 159 pack .cal -padx 10 -pady 10 160 update 161} {} 162 163incr c 164 165test Calendar-1.$c {Calendar destruction} { 166 destroy .cal 167 update 168} {} 169 170::tcltest::cleanupTests 171exit 172