os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/winTime.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/winTime.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,65 @@
1.4 +# This file tests the tclWinTime.c file.
1.5 +#
1.6 +# This file contains a collection of tests for one or more of the Tcl
1.7 +# built-in commands. Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1997 Sun Microsystems, Inc.
1.11 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.12 +#
1.13 +# See the file "license.terms" for information on usage and redistribution
1.14 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.15 +#
1.16 +# RCS: @(#) $Id: winTime.test,v 1.8.2.1 2003/04/12 20:11:34 kennykb Exp $
1.17 +
1.18 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.19 + package require tcltest
1.20 + namespace import -force ::tcltest::*
1.21 +}
1.22 +
1.23 +testConstraint testwinclock [llength [info commands testwinclock]]
1.24 +
1.25 +# The next two tests will crash on Windows if the check for negative
1.26 +# clock values is not done properly.
1.27 +
1.28 +test winTime-1.1 {TclpGetDate} {pcOnly} {
1.29 + set ::env(TZ) JST-9
1.30 + set result [clock format -1 -format %Y]
1.31 + unset ::env(TZ)
1.32 + set result
1.33 +} {1970}
1.34 +test winTime-1.2 {TclpGetDate} {pcOnly} {
1.35 + set ::env(TZ) PST8
1.36 + set result [clock format 1 -format %Y]
1.37 + unset ::env(TZ)
1.38 + set result
1.39 +} {1969}
1.40 +
1.41 +# Next test tries to make sure that the Tcl clock stays in step
1.42 +# with the Windows clock. 30 sec really isn't enough,
1.43 +# but how much time does a tester have patience for?
1.44 +
1.45 +test winTime-2.1 {Synchronization of Tcl and Windows clocks} {testwinclock} {
1.46 + # May fail due to OS/hardware discrepancies. See:
1.47 + # http://support.microsoft.com/default.aspx?scid=kb;en-us;274323
1.48 + set failed {}
1.49 + set ok 1
1.50 + foreach start_sec [testwinclock] break
1.51 + while { 1 } {
1.52 + foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] break
1.53 + set diff [expr { $tcl_sec - $sys_sec
1.54 + + 1.0e-6 * ( $tcl_usec - $sys_usec ) }]
1.55 + if { abs($diff) > 0.06 } {
1.56 + set failed "Tcl clock differs from system clock by $diff sec"
1.57 + break
1.58 + } else {
1.59 + testwinsleep 1
1.60 + }
1.61 + if { $sys_sec - $start_sec >= 30 } break
1.62 + }
1.63 + set failed
1.64 +} {}
1.65 +
1.66 +# cleanup
1.67 +::tcltest::cleanupTests
1.68 +return