Applied the patch for TIP #7 from Kevin Kenny.

See http://www.cs.man.ac.uk/fellowsd-bin/TIP/7.html

1 files changed, 78 insertions, 1 deletions

diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index 07f198b..8d290a8 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinTest.c,v 1.4 1999/10/29 03:05:13 hobbs Exp $
+ * RCS: @(#) $Id: tclWinTest.c,v 1.5 2000/11/21 21:33:43 andreas_kupries Exp $
  */
 
 #include "tclWinInt.h"
@@ -22,6 +22,10 @@ static int	TesteventloopCmd _ANSI_ARGS_((ClientData dummy,
 static int	TestvolumetypeCmd _ANSI_ARGS_((ClientData dummy,
 	Tcl_Interp *interp, int objc,
 	Tcl_Obj *CONST objv[]));
+static int      TestwinclockCmd _ANSI_ARGS_(( ClientData dummy,
+					      Tcl_Interp* interp,
+					      int objc,
+					      Tcl_Obj *CONST objv[] ));
 
 /*
  *----------------------------------------------------------------------
@@ -52,6 +56,8 @@ TclplatformtestInit(interp)
             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd,
             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd,
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     return TCL_OK;
 }
 
@@ -188,3 +194,74 @@ TestvolumetypeCmd(clientData, interp, objc, objv)
     return TCL_OK;
 #undef VOL_BUF_SIZE
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestclockCmd --
+ *
+ *	Command that returns the seconds and microseconds portions of
+ *	the system clock and of the Tcl clock so that they can be
+ *	compared to validate that the Tcl clock is staying in sync.
+ *
+ * Usage:
+ *	testclock
+ *
+ * Parameters:
+ *	None.
+ *
+ * Results:
+ *	Returns a standard Tcl result comprising a four-element list:
+ *	the seconds and microseconds portions of the system clock,
+ *	and the seconds and microseconds portions of the Tcl clock.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestwinclockCmd( ClientData dummy,
+				/* Unused */
+		 Tcl_Interp* interp,
+				/* Tcl interpreter */
+		 int objc,
+				/* Argument count */
+		 Tcl_Obj *CONST objv[] )
+				/* Argument vector */
+{
+    CONST static FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE };
+				/* The Posix epoch, expressed as a
+				 * Windows FILETIME */
+    Tcl_Time tclTime;		/* Tcl clock */
+    FILETIME sysTime;		/* System clock */
+    Tcl_Obj* result;		/* Result of the command */
+    LARGE_INTEGER t1, t2;
+
+    if ( objc != 1 ) {
+	Tcl_WrongNumArgs( interp, 1, objv, "" );
+	return TCL_ERROR;
+    }
+
+    TclpGetTime( &tclTime );
+    GetSystemTimeAsFileTime( &sysTime );
+    t1.LowPart = posixEpoch.dwLowDateTime;
+    t1.HighPart = posixEpoch.dwHighDateTime;
+    t2.LowPart = sysTime.dwLowDateTime;
+    t2.HighPart = sysTime.dwHighDateTime;
+    t2.QuadPart -= t1.QuadPart;
+
+    result = Tcl_NewObj();
+    Tcl_ListObjAppendElement
+	( interp, result, Tcl_NewIntObj( (int) (t2.QuadPart / 10000000 ) ) );
+    Tcl_ListObjAppendElement
+	( interp, result,
+	  Tcl_NewIntObj( (int) ( (t2.QuadPart / 10 ) % 1000000 ) ) );
+    Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.sec ) );
+    Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.usec ) );
+
+    Tcl_SetObjResult( interp, result );
+
+    return TCL_OK;
+}