diff options
Diffstat (limited to 'unix')
| -rw-r--r-- | unix/tclUnixTest.c | 65 |
1 files changed, 64 insertions, 1 deletions
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index e4c5662..905a986 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixTest.c,v 1.14.2.1 2003/10/13 01:00:38 hobbs Exp $ + * RCS: @(#) $Id: tclUnixTest.c,v 1.14.2.2 2006/03/19 22:47:30 vincentdarley Exp $ */ #include "tclInt.h" @@ -83,6 +83,8 @@ static int TestalarmCmd _ANSI_ARGS_((ClientData dummy, static int TestgotsigCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); static void AlarmHandler _ANSI_ARGS_(()); +static int TestchmodCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv)); /* *---------------------------------------------------------------------- @@ -105,6 +107,8 @@ int TclplatformtestInit(interp) Tcl_Interp *interp; /* Interpreter to add commands to. */ { + Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd, @@ -703,3 +707,62 @@ TestgotsigCmd(clientData, interp, argc, argv) gotsig = "0"; return TCL_OK; } + +/* + *--------------------------------------------------------------------------- + * + * TestchmodCmd -- + * + * Implements the "testchmod" cmd. Used when testing "file" command. + * The only attribute used by the Windows platform is the user write + * flag; if this is not set, the file is made read-only. Otehrwise, the + * file is made read-write. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Changes permissions of specified files. + * + *--------------------------------------------------------------------------- + */ + +static int +TestchmodCmd(dummy, interp, argc, argv) + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + CONST char **argv; /* Argument strings. */ +{ + int i, mode; + char *rest; + + if (argc < 2) { + usage: + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " mode file ?file ...?", NULL); + return TCL_ERROR; + } + + mode = (int) strtol(argv[1], &rest, 8); + if ((rest == argv[1]) || (*rest != '\0')) { + goto usage; + } + + for (i = 2; i < argc; i++) { + Tcl_DString buffer; + CONST char *translated; + + translated = Tcl_TranslateFileName(interp, argv[i], &buffer); + if (translated == NULL) { + return TCL_ERROR; + } + if (chmod(translated, (unsigned) mode) != 0) { + Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp), + NULL); + return TCL_ERROR; + } + Tcl_DStringFree(&buffer); + } + return TCL_OK; +} |