# This file is a Tcl script to test out [incr Widgets] Calendar 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: calendar.test,v 1.4 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 Calendar-1.$c {Calendar construction} { iwidgets::Calendar .cal pack .cal -padx 10 -pady 10 -fill both -expand yes update } {} incr c # # Option tests which are successful. # test Calendar-2.$o {configuration option} { llength [.cal configure] } {22} incr o foreach test { {-background #d9d9d9 #d9d9d9} {-buttonforeground green green} {-command {.cal configure -background red} {.cal configure -background red}} {-currentdatefont -*-helvetica-bold-r-normal--*-120-* -*-helvetica-bold-r-normal--*-120-*} {-cursor gumby gumby} {-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} {-int yes yes} {-int no no} {-outline black black} {-selectcolor blue blue} {-selectthickness 2 2} {-startday monday monday} {-titlefont -*-helvetica-bold-r-normal--*-140-* -*-helvetica-bold-r-normal--*-140-*} {-weekdaybackground mistyrose mistyrose} {-weekendbackground white white} {-width 350 350}} { set option [lindex $test 0] test Calendar-2.$o "configuration options, $option" { .cal configure $option [lindex $test 1] lindex [.cal configure $option] 4 } [lindex $test 2] update incr o } # # Option tests which fail and produce errors. # foreach test { {-backwardimage bogus {bad image name "bogus": image does not exist}} {-forwardimage bogus {bad image name "bogus": image does not exist}} {-startday bogus {bad startday option "bogus": should be sunday, monday, tuesday, wednesday, thursday, friday, or saturday}}} { set option [lindex $test 0] test Calendar-2.$o "configuration options, $option" { list [catch {.cal configure $option [lindex $test 1]} msg] $msg } [list 1 [lindex $test 2]] incr o } # # Method tests which are successful. # foreach test { {{.cal select 03/03/1960} {}} {{.cal get} {03/03/1960}} {{.cal show 03/03/1960} {}} {{.cal get -string} {03/03/1960}} {{.cal select now} {}} {{.cal show now} {}}} { set method [lindex [lindex $test 0] 1] test Calendar-3.$m "object methods, $method" { list [catch {eval [lindex $test 0]} msg] $msg } [list 0 [lindex $test 1]] update incr m } test Calendar-3.$m "object methods, clock clicks" { set clicks [clock scan "06/08/1964"] .cal show $clicks .cal select $clicks update .cal get } {06/08/1964} incr m # # Method tests which fail and produce errors # foreach test { {{.cal get bogus} {bad format option "bogus": should be -string or -clicks}} {{.cal select bogus} {bad date: "bogus", must be a valid date string, clock clicks value or the keyword now}} {{.cal 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 Calendar-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 Calendar-1.$c {Calendar destruction} { destroy .cal update } {} incr c test Calendar-1.$c {Calendar construction} { iwidgets::calendar .cal pack .cal -padx 10 -pady 10 update } {} incr c test Calendar-1.$c {Calendar destruction} { destroy .cal update } {} ::tcltest::cleanupTests exit