summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--unix/tclUnixTest.c44
1 files changed, 44 insertions, 0 deletions
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c
index b1d1676..e6812a7 100644
--- a/unix/tclUnixTest.c
+++ b/unix/tclUnixTest.c
@@ -54,6 +54,8 @@ static int TestfilehandlerCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
static int TestfilewaitCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
+static int TestfindexecutableCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int argc, char **argv));
static int TestgetopenfileCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int argc, char **argv));
int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
@@ -83,6 +85,8 @@ TclplatformtestInit(interp)
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
(ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
return TCL_OK;
@@ -388,6 +392,46 @@ TestfilewaitCmd(clientData, interp, argc, argv)
/*
*----------------------------------------------------------------------
*
+ * TestfindexecutableCmd --
+ *
+ * This procedure implements the "testfindexecutable" command. It is
+ * used to test Tcl_FindExecutable.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestfindexecutableCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ char *oldName;
+
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+ " argv0\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ oldName = tclExecutableName;
+ tclExecutableName = NULL;
+ Tcl_FindExecutable(argv[1]);
+ Tcl_SetResult(interp, tclExecutableName, TCL_DYNAMIC);
+ ckfree(tclExecutableName);
+ tclExecutableName = oldName;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TestgetopenfileCmd --
*
* This procedure implements the "testgetopenfile" command. It is