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 (c) 1997 Sun Microsystems, Inc. |
---|
8 | # Copyright (c) 1998-1999 by 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 | # |
---|
13 | # RCS: @(#) $Id: winTime.test,v 1.10 2004/06/23 15:36:59 dkf Exp $ |
---|
14 | |
---|
15 | if {[lsearch [namespace children] ::tcltest] == -1} { |
---|
16 | package require tcltest |
---|
17 | namespace import -force ::tcltest::* |
---|
18 | } |
---|
19 | |
---|
20 | testConstraint testwinclock [llength [info commands testwinclock]] |
---|
21 | |
---|
22 | # The next two tests will crash on Windows if the check for negative |
---|
23 | # clock values is not done properly. |
---|
24 | |
---|
25 | test winTime-1.1 {TclpGetDate} {win} { |
---|
26 | set ::env(TZ) JST-9 |
---|
27 | set result [clock format -1 -format %Y] |
---|
28 | unset ::env(TZ) |
---|
29 | set result |
---|
30 | } {1970} |
---|
31 | test winTime-1.2 {TclpGetDate} {win} { |
---|
32 | set ::env(TZ) PST8 |
---|
33 | set result [clock format 1 -format %Y] |
---|
34 | unset ::env(TZ) |
---|
35 | set result |
---|
36 | } {1969} |
---|
37 | |
---|
38 | # Next test tries to make sure that the Tcl clock stays in step |
---|
39 | # with the Windows clock. 30 sec really isn't enough, |
---|
40 | # but how much time does a tester have patience for? |
---|
41 | |
---|
42 | test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock} { |
---|
43 | # May fail due to OS/hardware discrepancies. See: |
---|
44 | # http://support.microsoft.com/default.aspx?scid=kb;en-us;274323 |
---|
45 | set failed {} |
---|
46 | set ok 1 |
---|
47 | foreach start_sec [testwinclock] break |
---|
48 | while { 1 } { |
---|
49 | foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] break |
---|
50 | set diff [expr { $tcl_sec - $sys_sec |
---|
51 | + 1.0e-6 * ( $tcl_usec - $sys_usec ) }] |
---|
52 | if { abs($diff) > 0.06 } { |
---|
53 | set failed "Tcl clock differs from system clock by $diff sec" |
---|
54 | break |
---|
55 | } else { |
---|
56 | testwinsleep 1 |
---|
57 | } |
---|
58 | if { $sys_sec - $start_sec >= 30 } break |
---|
59 | } |
---|
60 | set failed |
---|
61 | } {} |
---|
62 | |
---|
63 | # cleanup |
---|
64 | ::tcltest::cleanupTests |
---|
65 | return |
---|