# This file tests the tclWinTime.c file. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1997 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) winTime.test,v 1.5 2003/01/21 19:40:17 hunt Exp if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } # The next two tests will crash on Windows if the check for negative # clock values is not done properly. test winTime-1.1 {TclpGetDate} {pcOnly} { set ::env(TZ) JST-9 set result [clock format -1 -format %Y] unset ::env(TZ) set result } {1970} test winTime-1.2 {TclpGetDate} {pcOnly} { set ::env(TZ) PST8 set result [clock format 1 -format %Y] unset ::env(TZ) set result } {1969} # Next test tries to make sure that the Tcl clock stays in step # with the Windows clock. 3000 iterations really isn't enough, # but how many does a tester have patience for? test winTime-2.1 {Synchronization of Tcl and Windows clocks} {pcOnly} { set failed 0 foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] {} set olddiff [expr { abs ( $tcl_sec - $sys_sec + 1.0e-6 * ( $tcl_usec - $sys_usec ) ) }] set ok 1 for { set i 0 } { $i < 3000 } { incr i } { foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] {} set diff [expr { abs ( $tcl_sec - $sys_sec + 1.0e-6 * ( $tcl_usec - $sys_usec ) ) }] if { ( $diff > $olddiff + 1000 ) || ( $diff > 11000 ) } { set failed 1 break } else { set olddiff $diff after 1 } } set failed } {0} # cleanup ::tcltest::cleanupTests return