diff options
Diffstat (limited to 'win/tclWinTest.c')
| -rw-r--r-- | win/tclWinTest.c | 79 |
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; +} |