summaryrefslogtreecommitdiffstats
path: root/tests/winTime.test
diff options
context:
space:
mode:
authorandreas_kupries <andreas_kupries@noemail.net>2000-11-21 21:33:42 (GMT)
committerandreas_kupries <andreas_kupries@noemail.net>2000-11-21 21:33:42 (GMT)
commit29af8a3f2f499e192b1cd3a71872f62ea4db8a4d (patch)
treec54229eb2988d584ad2265757196eeb978203acb /tests/winTime.test
parent73c0bc94e3231808de747b1919e31348a999aac8 (diff)
downloadtcl-29af8a3f2f499e192b1cd3a71872f62ea4db8a4d.zip
tcl-29af8a3f2f499e192b1cd3a71872f62ea4db8a4d.tar.gz
tcl-29af8a3f2f499e192b1cd3a71872f62ea4db8a4d.tar.bz2
Applied the patch for TIP #7 from Kevin Kenny.
See http://www.cs.man.ac.uk/fellowsd-bin/TIP/7.html FossilOrigin-Name: 3d13d2887f7f389a6f140046ddd0f736579fe611
Diffstat (limited to 'tests/winTime.test')
-rw-r--r--tests/winTime.test28
1 files changed, 27 insertions, 1 deletions
diff --git a/tests/winTime.test b/tests/winTime.test
index 6bcb4b7..a8dec89 100644
--- a/tests/winTime.test
+++ b/tests/winTime.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: winTime.test,v 1.5 2000/04/10 17:19:06 ericm Exp $
+# RCS: @(#) $Id: winTime.test,v 1.6 2000/11/21 21:33:42 andreas_kupries Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -33,6 +33,32 @@ test winTime-1.2 {TclpGetDate} {pcOnly} {
set result
} {1969}
+# Next test tries to make sure that the Tcl clock stays in step
+# with the Windows clock. 3000 iterations really isn't enough,
+# but how many does a tester have patience for?
+
+test winTime-2.1 {Synchronization of Tcl and Windows clocks} {pcOnly} {
+ set failed 0
+ foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] {}
+ set olddiff [expr { abs ( $tcl_sec - $sys_sec
+ + 1.0e-6 * ( $tcl_usec - $sys_usec ) ) }]
+ set ok 1
+ for { set i 0 } { $i < 3000 } { incr i } {
+ foreach { sys_sec sys_usec tcl_sec tcl_usec } [testwinclock] {}
+ set diff [expr { abs ( $tcl_sec - $sys_sec
+ + 1.0e-6 * ( $tcl_usec - $sys_usec ) ) }]
+ if { ( $diff > $olddiff + 1000 )
+ || ( $diff > 11000 ) } {
+ set failed 1
+ break
+ } else {
+ set olddiff $diff
+ after 1
+ }
+ }
+ set failed
+} {0}
+
# cleanup
::tcltest::cleanupTests
return