# This file is a Tcl script to test out [incr Widgets] Watch 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: watch.test,v 1.3 2001/08/07 19:56:48 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 catch {destroy .w} # # Initial construction test # test Watch-1.$c {Watch construction} { iwidgets::Watch .w pack .w -padx 10 -pady 10 -fill both -expand yes update } {} incr c # # Option tests which are successful. # test Watch-2.$o {configuration option} { llength [.w configure] } {34} incr o foreach test { {-background #d9d9d9 #d9d9d9} {-cursor gumby gumby} {-hourcolor yellow yellow} {-minutecolor blue blue} {-secondcolor green green} {-tickcolor red red} {-clockcolor orange orange} {-clockstipple error error} {-state disabled disabled} {-state normal normal} {-showampm no no} {-showampm yes yes} {-hourradius .3 .3} {-minuteradius .5 .5} {-secondradius .7 .7}} { set option [lindex $test 0] test Watch-2.$o "configuration options, $option" { .w configure $option [lindex $test 1] lindex [.w configure $option] 4 } [lindex $test 2] update incr o .w show after 500 } # # Option tests which fail and produce errors. # foreach test { {-state bogus {bad state option "bogus": should be normal or disabled}} {-showampm bogus {bad showampm option "bogus": should be boolean}}} { set option [lindex $test 0] test Watch-2.$o "configuration options, $option" { list [catch {.w configure $option [lindex $test 1]} msg] $msg } [list 1 [lindex $test 2]] incr o } # # Method tests which are successful. # foreach test { {{.w show "11:11:11"} {}} {{.w get} "11:11:11 AM"} {{.w show "now"} {}}} { set method [lindex [lindex $test 0] 1] test Watch-3.$m "object methods, $method" { list [catch {eval [lindex $test 0]} msg] $msg } [list 0 [lindex $test 1]] update incr m after 500 } foreach test { {{.w show bogus} {bad time: "bogus", must be a valid time string, clock clicks value or the keyword now}} {{.w get bogus} {bad format option "bogus": should be -string or -clicks}}} { set method [lindex [lindex $test 0] 1] test ScrolledListBox-3.$m "object methods, $method" { list [catch {eval [lindex $test 0]} msg] $msg } [list 1 [lindex $test 1]] incr m .w show after 500 } # # Conclusion of constrcution/destruction tests # test Watch-1.$c {Watch destruction} { destroy .w update } {} incr c test Watch-1.$c {Watch construction} { iwidgets::watch .w pack .w -padx 10 -pady 10 -fill both -expand yes update } {} incr c test Watch-1.$c {Watch destruction} { destroy .w update } {} incr c test Watch-1.$c {Watch destruction} { iwidgets::watch .w pack .w destroy .w update } {} ::tcltest::cleanupTests exit