| 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 |
|---|
