Disable timing dependent tests when running under AppVerifier on Windows

1 files changed, 46 insertions, 1 deletions

diff --git a/generic/tclTest.c b/generic/tclTest.c
index 367be00..c67ec25 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -336,6 +336,7 @@ static Tcl_ObjCmdProc	TestcpuidCmd;
 static Tcl_ObjCmdProc	TestApplyLambdaCmd;
 #ifdef _WIN32
 static Tcl_ObjCmdProc	TestHandleCountCmd;
+static Tcl_ObjCmdProc	TestAppVerifierPresentCmd;
 #endif
 
 static const Tcl_Filesystem testReportingFilesystem = {
@@ -731,6 +732,8 @@ Tcltest_Init(
 #if defined(_WIN32)
     Tcl_CreateObjCommand(interp, "testhandlecount", TestHandleCountCmd,
 	    NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testappverifierpresent",
+	    TestAppVerifierPresentCmd, NULL, NULL);
 #endif
 
     if (TclObjTest_Init(interp) != TCL_OK) {
@@ -8816,7 +8819,6 @@ vamoose:
  *
  *----------------------------------------------------------------------
  */
-
 static int
 TestHandleCountCmd(
     TCL_UNUSED(void *),
@@ -8837,6 +8839,49 @@ TestHandleCountCmd(
 	    "GetProcessHandleCount failed", -1));
     return TCL_ERROR;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestAppVerifierPresentCmd --
+ *
+ *	This procedure implements the "testappverifierpresent" command.
+ *	Result is 1 if the process is running under the Application Verifier,
+ *	0 otherwise.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+TestAppVerifierPresentCmd(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Arguments. */
+{
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, "");
+	return TCL_ERROR;
+    }
+    const char *dlls[] = {
+	"verifier.dll", "vfbasics.dll", "vfcompat.dll", "vfnet.dll", NULL
+    };
+    const char **dll;
+    for (dll = dlls; dll; ++dll) {
+	if (GetModuleHandleA(*dll) != NULL) {
+	    break;
+	}
+    }
+    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(*dll != NULL));
+    return TCL_OK;
+}
+
+
 #endif /* _WIN32 */
 
 /*