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