# 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