summaryrefslogtreecommitdiffstats
path: root/win/tclWinTest.c
diff options
context:
space:
mode:
authorKevin B Kenny <kennykb@acm.org>2003-04-12 20:11:33 (GMT)
committerKevin B Kenny <kennykb@acm.org>2003-04-12 20:11:33 (GMT)
commitb0cc421ee0a6c1691d7db034c52ae9fcb5295627 (patch)
treedfa1a81b176b70021b0ecfa66e96c7a6a66d2ba1 /win/tclWinTest.c
parent47554fcd67f382566a72813c4b11bda27ecfb201 (diff)
downloadtcl-b0cc421ee0a6c1691d7db034c52ae9fcb5295627.zip
tcl-b0cc421ee0a6c1691d7db034c52ae9fcb5295627.tar.gz
tcl-b0cc421ee0a6c1691d7db034c52ae9fcb5295627.tar.bz2
Fixed Bug 710310 (duplicate test numbers in clock.test). Made major
changes to tclWinTime.c and related code to improve loop filter stability.
Diffstat (limited to 'win/tclWinTest.c')
-rw-r--r--win/tclWinTest.c66
1 files changed, 64 insertions, 2 deletions
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index 51b72e7..96b1a28 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.8 2002/12/17 02:47:39 davygrvy Exp $
+ * RCS: @(#) $Id: tclWinTest.c,v 1.8.2.1 2003/04/12 20:11:34 kennykb Exp $
*/
#define USE_COMPAT_CONST
@@ -27,6 +27,10 @@ static int TestwinclockCmd _ANSI_ARGS_(( ClientData dummy,
Tcl_Interp* interp,
int objc,
Tcl_Obj *CONST objv[] ));
+static int TestwinsleepCmd _ANSI_ARGS_(( ClientData dummy,
+ Tcl_Interp* interp,
+ int objc,
+ Tcl_Obj *CONST objv[] ));
static Tcl_ObjCmdProc TestExceptionCmd;
@@ -61,6 +65,11 @@ TclplatformtestInit(interp)
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand( interp,
+ "testwinsleep",
+ TestwinsleepCmd,
+ (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL );
Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL);
return TCL_OK;
}
@@ -202,7 +211,7 @@ TestvolumetypeCmd(clientData, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * TestclockCmd --
+ * TestwinclockCmd --
*
* Command that returns the seconds and microseconds portions of
* the system clock and of the Tcl clock so that they can be
@@ -242,12 +251,15 @@ TestwinclockCmd( ClientData dummy,
FILETIME sysTime; /* System clock */
Tcl_Obj* result; /* Result of the command */
LARGE_INTEGER t1, t2;
+ LARGE_INTEGER p1, p2;
if ( objc != 1 ) {
Tcl_WrongNumArgs( interp, 1, objv, "" );
return TCL_ERROR;
}
+ QueryPerformanceCounter( &p1 );
+
Tcl_GetTime( &tclTime );
GetSystemTimeAsFileTime( &sysTime );
t1.LowPart = posixEpoch.dwLowDateTime;
@@ -256,6 +268,8 @@ TestwinclockCmd( ClientData dummy,
t2.HighPart = sysTime.dwHighDateTime;
t2.QuadPart -= t1.QuadPart;
+ QueryPerformanceCounter( &p2 );
+
result = Tcl_NewObj();
Tcl_ListObjAppendElement
( interp, result, Tcl_NewIntObj( (int) (t2.QuadPart / 10000000 ) ) );
@@ -265,11 +279,59 @@ TestwinclockCmd( ClientData dummy,
Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.sec ) );
Tcl_ListObjAppendElement( interp, result, Tcl_NewIntObj( tclTime.usec ) );
+ Tcl_ListObjAppendElement( interp, result, Tcl_NewWideIntObj( p1.QuadPart ) );
+ Tcl_ListObjAppendElement( interp, result, Tcl_NewWideIntObj( p2.QuadPart ) );
+
Tcl_SetObjResult( interp, result );
return TCL_OK;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Testwinsleepcmd --
+ *
+ * Causes this process to wait for the given number of milliseconds
+ * by means of a direct call to Sleep.
+ *
+ * Usage:
+ * testwinsleep <n>
+ *
+ * Parameters:
+ * n - the number of milliseconds to sleep
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sleeps for the requisite number of milliseconds.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+TestwinsleepCmd( ClientData clientData,
+ /* Unused */
+ Tcl_Interp* interp,
+ /* Tcl interpreter */
+ int objc,
+ /* Parameter count */
+ Tcl_Obj * CONST * objv )
+ /* Parameter vector */
+{
+ int ms;
+ if ( objc != 2 ) {
+ Tcl_WrongNumArgs( interp, 1, objv, "ms" );
+ return TCL_ERROR;
+ }
+ if ( Tcl_GetIntFromObj( interp, objv[1], &ms ) != TCL_OK ) {
+ return TCL_ERROR;
+ }
+ Sleep( (DWORD) ms );
+ return TCL_OK;
+}
+
/*
*----------------------------------------------------------------------
*