1# This file tests the tclWinTime.c file. 2# 3# This file contains a collection of tests for one or more of the Tcl 4# built-in commands. Sourcing this file into Tcl runs the tests and 5# generates output for errors. No output means no errors were found. 6# 7# Copyright © 1997 Sun Microsystems, Inc. 8# Copyright © 1998-1999 Scriptics Corporation. 9# 10# See the file "license.terms" for information on usage and redistribution 11# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 12 13if {"::tcltest" ni [namespace children]} { 14 package require tcltest 2.5 15 namespace import -force ::tcltest::* 16} 17 18::tcltest::loadTestedCommands 19catch [list package require -exact tcl::test [info patchlevel]] 20 21testConstraint testwinclock [llength [info commands testwinclock]] 22# Some things fail under all Continuous Integration systems for subtle reasons 23# such as CI often running with elevated privileges in a container. 24testConstraint notInCIenv [expr {![info exists ::env(CI)]}] 25 26# The next two tests will crash on Windows if the check for negative 27# clock values is not done properly. 28 29test winTime-1.1 {TclpGetDate} {win} { 30 set ::env(TZ) JST-9 31 set result [clock format -1 -format %Y] 32 unset ::env(TZ) 33 set result 34} {1970} 35test winTime-1.2 {TclpGetDate} {win} { 36 set ::env(TZ) PST8 37 set result [clock format 1 -format %Y] 38 unset ::env(TZ) 39 set result 40} {1969} 41 42# Next test tries to make sure that the Tcl clock stays in step 43# with the Windows clock. 30 sec really isn't enough, 44# but how much time does a tester have patience for? 45 46test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock notInCIenv} { 47 # May fail due to OS/hardware discrepancies. See: 48 # http://support.microsoft.com/default.aspx?scid=kb;en-us;274323 49 set failed {} 50 set ok 1 51 foreach start_sec [testwinclock] break 52 while { 1 } { 53 foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] break 54 set diff [expr { $tcl_sec - $sys_sec 55 + 1.0e-6 * ( $tcl_usec - $sys_usec ) }] 56 if { abs($diff) > 0.1 } { 57 set failed "Tcl clock differs from system clock by $diff sec" 58 break 59 } else { 60 testwinsleep 1 61 } 62 if { $sys_sec - $start_sec >= 30 } break 63 } 64 set failed 65} {} 66 67# cleanup 68::tcltest::cleanupTests 69return 70