itcl/iwidgets/tests/calendar.test

   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$
  15
  16 package require tcltest
  17 namespace import -force ::tcltest::*
  18
  19 if [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
  31 if {[string compare test [info procs test]] == 1} {
  32     source defs
  33 }
  34
  35 wm geometry . {}
  36 raise .
  37
  38 set c 1
  39 set o 1
  40 set m 1
  41
  42 #
  43 # Initial construction test
  44 #
  45 test Calendar-1.$c {Calendar construction} {
  46     iwidgets::Calendar .cal
  47     pack .cal -padx 10 -pady 10 -fill both -expand yes
  48     update
  49 } {}
  50
  51 incr c
  52
  53 #
  54 # Option tests which are successful.
  55 #
  56 test Calendar-2.$o {configuration option} {
  57     llength [.cal configure]
  58 } {22}
  59
  60 incr o
  61
  62 foreach 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 #
  95 foreach 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 #
 109 foreach 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
 124 test 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}
 131 incr m
 132
 133 #
 134 # Method tests which fail and produce errors
 135 #
 136 foreach 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 #
 150 test Calendar-1.$c {Calendar destruction} {
 151     destroy .cal
 152     update
 153 } {}
 154
 155 incr c
 156
 157 test Calendar-1.$c {Calendar construction} {
 158     iwidgets::calendar .cal
 159     pack .cal -padx 10 -pady 10
 160     update
 161 } {}
 162
 163 incr c
 164
 165 test Calendar-1.$c {Calendar destruction} {
 166     destroy .cal
 167     update
 168 } {}
 169
 170 ::tcltest::cleanupTests
 171 exit