diff options
Diffstat (limited to 'unix/tclUnixTest.c')
| -rw-r--r-- | unix/tclUnixTest.c | 44 |
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 |