1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
-
+
+
+
+
+
|
/*
* tclWinTest.c --
*
* Contains commands for platform specific tests on Windows.
*
* Copyright (c) 1996 Sun Microsystems, Inc.
*
* 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
#include "tclWinInt.h"
/*
* Forward declarations of procedures defined later in this file:
*/
int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
static int TesteventloopCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
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[] ));
static int TestwinsleepCmd _ANSI_ARGS_(( ClientData dummy,
Tcl_Interp* interp,
int objc,
Tcl_Obj *CONST objv[] ));
static Tcl_ObjCmdProc TestExceptionCmd;
/*
*----------------------------------------------------------------------
|
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
+
+
+
+
+
|
Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,
(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);
Tcl_CreateObjCommand( interp,
"testwinsleep",
TestwinsleepCmd,
(ClientData) 0,
(Tcl_CmdDeleteProc *) NULL );
Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
|
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
|
-
+
|
return TCL_OK;
#undef VOL_BUF_SIZE
}
/*
*----------------------------------------------------------------------
*
* TestclockCmd --
* TestwinclockCmd --
*
* 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
|
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
|
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
|
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
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;
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;
t1.HighPart = posixEpoch.dwHighDateTime;
t2.LowPart = sysTime.dwLowDateTime;
t2.HighPart = sysTime.dwHighDateTime;
t2.QuadPart -= t1.QuadPart;
QueryPerformanceCounter( &p2 );
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_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;
}
/*
*----------------------------------------------------------------------
*
* TestExceptionCmd --
*
* Causes this process to end with the named exception. Used for
* testing Tcl_WaitPid().
|