tclUnixTest.c

Go to the documentation of this file.
00001 /*
00002  * tclUnixTest.c --
00003  *
00004  *      Contains platform specific test commands for the Unix platform.
00005  *
00006  * Copyright (c) 1996-1997 Sun Microsystems, Inc.
00007  * Copyright (c) 1998 by Scriptics Corporation.
00008  *
00009  * See the file "license.terms" for information on usage and redistribution of
00010  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
00011  *
00012  * RCS: @(#) $Id: tclUnixTest.c,v 1.26 2007/04/20 06:11:00 kennykb Exp $
00013  */
00014 
00015 #include "tclInt.h"
00016 
00017 /*
00018  * The headers are needed for the testalarm command that verifies the use of
00019  * SA_RESTART in signal handlers.
00020  */
00021 
00022 #include <signal.h>
00023 #include <sys/resource.h>
00024 
00025 /*
00026  * The following macros convert between TclFile's and fd's. The conversion
00027  * simple involves shifting fd's up by one to ensure that no valid fd is ever
00028  * the same as NULL. Note that this code is duplicated from tclUnixPipe.c
00029  */
00030 
00031 #define MakeFile(fd)    ((TclFile)INT2PTR(((int)(fd))+1))
00032 #define GetFd(file)     (PTR2INT(file)-1)
00033 
00034 /*
00035  * The stuff below is used to keep track of file handlers created and
00036  * exercised by the "testfilehandler" command.
00037  */
00038 
00039 typedef struct Pipe {
00040     TclFile readFile;           /* File handle for reading from the pipe.
00041                                  * NULL means pipe doesn't exist yet. */
00042     TclFile writeFile;          /* File handle for writing from the pipe. */
00043     int readCount;              /* Number of times the file handler for this
00044                                  * file has triggered and the file was
00045                                  * readable. */
00046     int writeCount;             /* Number of times the file handler for this
00047                                  * file has triggered and the file was
00048                                  * writable. */
00049 } Pipe;
00050 
00051 #define MAX_PIPES 10
00052 static Pipe testPipes[MAX_PIPES];
00053 
00054 /*
00055  * The stuff below is used by the testalarm and testgotsig ommands.
00056  */
00057 
00058 static char *gotsig = "0";
00059 
00060 /*
00061  * Forward declarations of functions defined later in this file:
00062  */
00063 
00064 static void             TestFileHandlerProc(ClientData clientData, int mask);
00065 static int              TestfilehandlerCmd(ClientData dummy,
00066                             Tcl_Interp *interp, int argc, CONST char **argv);
00067 static int              TestfilewaitCmd(ClientData dummy,
00068                             Tcl_Interp *interp, int argc, CONST char **argv);
00069 static int              TestfindexecutableCmd(ClientData dummy,
00070                             Tcl_Interp *interp, int argc, CONST char **argv);
00071 static int              TestgetopenfileCmd(ClientData dummy,
00072                             Tcl_Interp *interp, int argc, CONST char **argv);
00073 static int              TestgetdefencdirCmd(ClientData dummy,
00074                             Tcl_Interp *interp, int argc, CONST char **argv);
00075 static int              TestsetdefencdirCmd(ClientData dummy,
00076                             Tcl_Interp *interp, int argc, CONST char **argv);
00077 int                     TclplatformtestInit(Tcl_Interp *interp);
00078 static int              TestalarmCmd(ClientData dummy,
00079                             Tcl_Interp *interp, int argc, CONST char **argv);
00080 static int              TestgotsigCmd(ClientData dummy,
00081                             Tcl_Interp *interp, int argc, CONST char **argv);
00082 static void             AlarmHandler(int signum);
00083 static int              TestchmodCmd(ClientData dummy,
00084                             Tcl_Interp *interp, int argc, CONST char **argv);
00085 
00086 /*
00087  *----------------------------------------------------------------------
00088  *
00089  * TclplatformtestInit --
00090  *
00091  *      Defines commands that test platform specific functionality for Unix
00092  *      platforms.
00093  *
00094  * Results:
00095  *      A standard Tcl result.
00096  *
00097  * Side effects:
00098  *      Defines new commands.
00099  *
00100  *----------------------------------------------------------------------
00101  */
00102 
00103 int
00104 TclplatformtestInit(
00105     Tcl_Interp *interp)         /* Interpreter to add commands to. */
00106 {
00107     Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
00108             (ClientData) 0, NULL);
00109     Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd,
00110             (ClientData) 0, NULL);
00111     Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd,
00112             (ClientData) 0, NULL);
00113     Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
00114             (ClientData) 0, NULL);
00115     Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
00116             (ClientData) 0, NULL);
00117     Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd,
00118             (ClientData) 0, NULL);
00119     Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd,
00120             (ClientData) 0, NULL);
00121     Tcl_CreateCommand(interp, "testalarm", TestalarmCmd,
00122             (ClientData) 0, NULL);
00123     Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd,
00124             (ClientData) 0, NULL);
00125     return TCL_OK;
00126 }
00127 
00128 /*
00129  *----------------------------------------------------------------------
00130  *
00131  * TestfilehandlerCmd --
00132  *
00133  *      This function implements the "testfilehandler" command. It is used to
00134  *      test Tcl_CreateFileHandler, Tcl_DeleteFileHandler, and TclWaitForFile.
00135  *
00136  * Results:
00137  *      A standard Tcl result.
00138  *
00139  * Side effects:
00140  *      None.
00141  *
00142  *----------------------------------------------------------------------
00143  */
00144 
00145 static int
00146 TestfilehandlerCmd(
00147     ClientData clientData,      /* Not used. */
00148     Tcl_Interp *interp,         /* Current interpreter. */
00149     int argc,                   /* Number of arguments. */
00150     CONST char **argv)          /* Argument strings. */
00151 {
00152     Pipe *pipePtr;
00153     int i, mask, timeout;
00154     static int initialized = 0;
00155     char buffer[4000];
00156     TclFile file;
00157 
00158     /*
00159      * NOTE: When we make this code work on Windows also, the following
00160      * variable needs to be made Unix-only.
00161      */
00162 
00163     if (!initialized) {
00164         for (i = 0; i < MAX_PIPES; i++) {
00165             testPipes[i].readFile = NULL;
00166         }
00167         initialized = 1;
00168     }
00169 
00170     if (argc < 2) {
00171         Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
00172                 " option ... \"", NULL);
00173         return TCL_ERROR;
00174     }
00175     pipePtr = NULL;
00176     if (argc >= 3) {
00177         if (Tcl_GetInt(interp, argv[2], &i) != TCL_OK) {
00178             return TCL_ERROR;
00179         }
00180         if (i >= MAX_PIPES) {
00181             Tcl_AppendResult(interp, "bad index ", argv[2], NULL);
00182             return TCL_ERROR;
00183         }
00184         pipePtr = &testPipes[i];
00185     }
00186 
00187     if (strcmp(argv[1], "close") == 0) {
00188         for (i = 0; i < MAX_PIPES; i++) {
00189             if (testPipes[i].readFile != NULL) {
00190                 TclpCloseFile(testPipes[i].readFile);
00191                 testPipes[i].readFile = NULL;
00192                 TclpCloseFile(testPipes[i].writeFile);
00193                 testPipes[i].writeFile = NULL;
00194             }
00195         }
00196     } else if (strcmp(argv[1], "clear") == 0) {
00197         if (argc != 3) {
00198             Tcl_AppendResult(interp, "wrong # arguments: should be \"",
00199                     argv[0], " clear index\"", NULL);
00200             return TCL_ERROR;
00201         }
00202         pipePtr->readCount = pipePtr->writeCount = 0;
00203     } else if (strcmp(argv[1], "counts") == 0) {
00204         char buf[TCL_INTEGER_SPACE * 2];
00205 
00206         if (argc != 3) {
00207             Tcl_AppendResult(interp, "wrong # arguments: should be \"",
00208                     argv[0], " counts index\"", NULL);
00209             return TCL_ERROR;
00210         }
00211         sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount);
00212         Tcl_SetResult(interp, buf, TCL_VOLATILE);
00213     } else if (strcmp(argv[1], "create") == 0) {
00214         if (argc != 5) {
00215             Tcl_AppendResult(interp, "wrong # arguments: should be \"",
00216                     argv[0], " create index readMode writeMode\"", NULL);
00217             return TCL_ERROR;
00218         }
00219         if (pipePtr->readFile == NULL) {
00220             if (!TclpCreatePipe(&pipePtr->readFile, &pipePtr->writeFile)) {
00221                 Tcl_AppendResult(interp, "couldn't open pipe: ",
00222                         Tcl_PosixError(interp), NULL);
00223                 return TCL_ERROR;
00224             }
00225 #ifdef O_NONBLOCK
00226             fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK);
00227             fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK);
00228 #else
00229             Tcl_SetResult(interp, "can't make pipes non-blocking",
00230                     TCL_STATIC);
00231             return TCL_ERROR;
00232 #endif
00233         }
00234         pipePtr->readCount = 0;
00235         pipePtr->writeCount = 0;
00236 
00237         if (strcmp(argv[3], "readable") == 0) {
00238             Tcl_CreateFileHandler(GetFd(pipePtr->readFile), TCL_READABLE,
00239                     TestFileHandlerProc, (ClientData) pipePtr);
00240         } else if (strcmp(argv[3], "off") == 0) {
00241             Tcl_DeleteFileHandler(GetFd(pipePtr->readFile));
00242         } else if (strcmp(argv[3], "disabled") == 0) {
00243             Tcl_CreateFileHandler(GetFd(pipePtr->readFile), 0,
00244                     TestFileHandlerProc, (ClientData) pipePtr);
00245         } else {
00246             Tcl_AppendResult(interp, "bad read mode \"", argv[3], "\"", NULL);
00247             return TCL_ERROR;
00248         }
00249         if (strcmp(argv[4], "writable") == 0) {
00250             Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), TCL_WRITABLE,
00251                     TestFileHandlerProc, (ClientData) pipePtr);
00252         } else if (strcmp(argv[4], "off") == 0) {
00253             Tcl_DeleteFileHandler(GetFd(pipePtr->writeFile));
00254         } else if (strcmp(argv[4], "disabled") == 0) {
00255             Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), 0,
00256                     TestFileHandlerProc, (ClientData) pipePtr);
00257         } else {
00258             Tcl_AppendResult(interp, "bad read mode \"", argv[4], "\"", NULL);
00259             return TCL_ERROR;
00260         }
00261     } else if (strcmp(argv[1], "empty") == 0) {
00262         if (argc != 3) {
00263             Tcl_AppendResult(interp, "wrong # arguments: should be \"",
00264                     argv[0], " empty index\"", NULL);
00265             return TCL_ERROR;
00266         }
00267 
00268         while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) {
00269             /* Empty loop body. */
00270         }
00271     } else if (strcmp(argv[1], "fill") == 0) {
00272         if (argc != 3) {
00273             Tcl_AppendResult(interp, "wrong # arguments: should be \"",
00274                     argv[0], " fill index\"", NULL);
00275             return TCL_ERROR;
00276         }
00277 
00278         memset(buffer, 'a', 4000);
00279         while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) {
00280             /* Empty loop body. */
00281         }
00282     } else if (strcmp(argv[1], "fillpartial") == 0) {
00283         char buf[TCL_INTEGER_SPACE];
00284 
00285         if (argc != 3) {
00286             Tcl_AppendResult(interp, "wrong # arguments: should be \"",
00287                     argv[0], " fillpartial index\"", NULL);
00288             return TCL_ERROR;
00289         }
00290 
00291         memset(buffer, 'b', 10);
00292         TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10));
00293         Tcl_SetResult(interp, buf, TCL_VOLATILE);
00294     } else if (strcmp(argv[1], "oneevent") == 0) {
00295         Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT);
00296     } else if (strcmp(argv[1], "wait") == 0) {
00297         if (argc != 5) {
00298             Tcl_AppendResult(interp, "wrong # arguments: should be \"",
00299                     argv[0], " wait index readable|writable timeout\"", NULL);
00300             return TCL_ERROR;
00301         }
00302         if (pipePtr->readFile == NULL) {
00303             Tcl_AppendResult(interp, "pipe ", argv[2], " doesn't exist", NULL);
00304             return TCL_ERROR;
00305         }
00306         if (strcmp(argv[3], "readable") == 0) {
00307             mask = TCL_READABLE;
00308             file = pipePtr->readFile;
00309         } else {
00310             mask = TCL_WRITABLE;
00311             file = pipePtr->writeFile;
00312         }
00313         if (Tcl_GetInt(interp, argv[4], &timeout) != TCL_OK) {
00314             return TCL_ERROR;
00315         }
00316         i = TclUnixWaitForFile(GetFd(file), mask, timeout);
00317         if (i & TCL_READABLE) {
00318             Tcl_AppendElement(interp, "readable");
00319         }
00320         if (i & TCL_WRITABLE) {
00321             Tcl_AppendElement(interp, "writable");
00322         }
00323     } else if (strcmp(argv[1], "windowevent") == 0) {
00324         Tcl_DoOneEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT);
00325     } else {
00326         Tcl_AppendResult(interp, "bad option \"", argv[1],
00327                 "\": must be close, clear, counts, create, empty, fill, "
00328                 "fillpartial, oneevent, wait, or windowevent", NULL);
00329         return TCL_ERROR;
00330     }
00331     return TCL_OK;
00332 }
00333 
00334 static void
00335 TestFileHandlerProc(
00336     ClientData clientData,      /* Points to a Pipe structure. */
00337     int mask)                   /* Indicates which events happened:
00338                                  * TCL_READABLE or TCL_WRITABLE. */
00339 {
00340     Pipe *pipePtr = (Pipe *) clientData;
00341 
00342     if (mask & TCL_READABLE) {
00343         pipePtr->readCount++;
00344     }
00345     if (mask & TCL_WRITABLE) {
00346         pipePtr->writeCount++;
00347     }
00348 }
00349 
00350 /*
00351  *----------------------------------------------------------------------
00352  *
00353  * TestfilewaitCmd --
00354  *
00355  *      This function implements the "testfilewait" command. It is used to
00356  *      test TclUnixWaitForFile.
00357  *
00358  * Results:
00359  *      A standard Tcl result.
00360  *
00361  * Side effects:
00362  *      None.
00363  *
00364  *----------------------------------------------------------------------
00365  */
00366 
00367 static int
00368 TestfilewaitCmd(
00369     ClientData clientData,      /* Not used. */
00370     Tcl_Interp *interp,         /* Current interpreter. */
00371     int argc,                   /* Number of arguments. */
00372     CONST char **argv)          /* Argument strings. */
00373 {
00374     int mask, result, timeout;
00375     Tcl_Channel channel;
00376     int fd;
00377     ClientData data;
00378 
00379     if (argc != 4) {
00380         Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
00381                 " file readable|writable|both timeout\"", NULL);
00382         return TCL_ERROR;
00383     }
00384     channel = Tcl_GetChannel(interp, argv[1], NULL);
00385     if (channel == NULL) {
00386         return TCL_ERROR;
00387     }
00388     if (strcmp(argv[2], "readable") == 0) {
00389         mask = TCL_READABLE;
00390     } else if (strcmp(argv[2], "writable") == 0){
00391         mask = TCL_WRITABLE;
00392     } else if (strcmp(argv[2], "both") == 0){
00393         mask = TCL_WRITABLE|TCL_READABLE;
00394     } else {
00395         Tcl_AppendResult(interp, "bad argument \"", argv[2],
00396                 "\": must be readable, writable, or both", NULL);
00397         return TCL_ERROR;
00398     }
00399     if (Tcl_GetChannelHandle(channel,
00400             (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE,
00401             (ClientData*) &data) != TCL_OK) {
00402         Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC);
00403         return TCL_ERROR;
00404     }
00405     fd = PTR2INT(data);
00406     if (Tcl_GetInt(interp, argv[3], &timeout) != TCL_OK) {
00407         return TCL_ERROR;
00408     }
00409     result = TclUnixWaitForFile(fd, mask, timeout);
00410     if (result & TCL_READABLE) {
00411         Tcl_AppendElement(interp, "readable");
00412     }
00413     if (result & TCL_WRITABLE) {
00414         Tcl_AppendElement(interp, "writable");
00415     }
00416     return TCL_OK;
00417 }
00418 
00419 /*
00420  *----------------------------------------------------------------------
00421  *
00422  * TestfindexecutableCmd --
00423  *
00424  *      This function implements the "testfindexecutable" command. It is used
00425  *      to test TclpFindExecutable.
00426  *
00427  * Results:
00428  *      A standard Tcl result.
00429  *
00430  * Side effects:
00431  *      None.
00432  *
00433  *----------------------------------------------------------------------
00434  */
00435 
00436 static int
00437 TestfindexecutableCmd(
00438     ClientData clientData,      /* Not used. */
00439     Tcl_Interp *interp,         /* Current interpreter. */
00440     int argc,                   /* Number of arguments. */
00441     CONST char **argv)          /* Argument strings. */
00442 {
00443     Tcl_Obj *saveName;
00444 
00445     if (argc != 2) {
00446         Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
00447                 " argv0\"", NULL);
00448         return TCL_ERROR;
00449     }
00450 
00451     saveName = TclGetObjNameOfExecutable();
00452     Tcl_IncrRefCount(saveName);
00453 
00454     TclpFindExecutable(argv[1]);
00455     Tcl_SetObjResult(interp, TclGetObjNameOfExecutable());
00456 
00457     TclSetObjNameOfExecutable(saveName, NULL);
00458     Tcl_DecrRefCount(saveName);
00459     return TCL_OK;
00460 }
00461 
00462 /*
00463  *----------------------------------------------------------------------
00464  *
00465  * TestgetopenfileCmd --
00466  *
00467  *      This function implements the "testgetopenfile" command. It is used to
00468  *      get a FILE * value from a registered channel.
00469  *
00470  * Results:
00471  *      A standard Tcl result.
00472  *
00473  * Side effects:
00474  *      None.
00475  *
00476  *----------------------------------------------------------------------
00477  */
00478 
00479 static int
00480 TestgetopenfileCmd(
00481     ClientData clientData,      /* Not used. */
00482     Tcl_Interp *interp,         /* Current interpreter. */
00483     int argc,                   /* Number of arguments. */
00484     CONST char **argv)          /* Argument strings. */
00485 {
00486     ClientData filePtr;
00487 
00488     if (argc != 3) {
00489         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
00490                 " channelName forWriting\"", NULL);
00491         return TCL_ERROR;
00492     }
00493     if (Tcl_GetOpenFile(interp, argv[1], atoi(argv[2]), 1, &filePtr)
00494             == TCL_ERROR) {
00495         return TCL_ERROR;
00496     }
00497     if (filePtr == (ClientData) NULL) {
00498         Tcl_AppendResult(interp,
00499                 "Tcl_GetOpenFile succeeded but FILE * NULL!", NULL);
00500         return TCL_ERROR;
00501     }
00502     return TCL_OK;
00503 }
00504 
00505 /*
00506  *----------------------------------------------------------------------
00507  *
00508  * TestsetdefencdirCmd --
00509  *
00510  *      This function implements the "testsetdefenc" command. It is used to
00511  *      test Tcl_SetDefaultEncodingDir().
00512  *
00513  * Results:
00514  *      A standard Tcl result.
00515  *
00516  * Side effects:
00517  *      None.
00518  *
00519  *----------------------------------------------------------------------
00520  */
00521 
00522 static int
00523 TestsetdefencdirCmd(
00524     ClientData clientData,      /* Not used. */
00525     Tcl_Interp *interp,         /* Current interpreter. */
00526     int argc,                   /* Number of arguments. */
00527     CONST char **argv)          /* Argument strings. */
00528 {
00529     if (argc != 2) {
00530         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
00531                 " defaultDir\"", NULL);
00532         return TCL_ERROR;
00533     }
00534 
00535     Tcl_SetDefaultEncodingDir(argv[1]);
00536     return TCL_OK;
00537 }
00538 
00539 /*
00540  *----------------------------------------------------------------------
00541  *
00542  * TestgetdefencdirCmd --
00543  *
00544  *      This function implements the "testgetdefenc" command. It is used to
00545  *      test Tcl_GetDefaultEncodingDir().
00546  *
00547  * Results:
00548  *      A standard Tcl result.
00549  *
00550  * Side effects:
00551  *      None.
00552  *
00553  *----------------------------------------------------------------------
00554  */
00555 
00556 static int
00557 TestgetdefencdirCmd(
00558     ClientData clientData,      /* Not used. */
00559     Tcl_Interp *interp,         /* Current interpreter. */
00560     int argc,                   /* Number of arguments. */
00561     CONST char **argv)          /* Argument strings. */
00562 {
00563     if (argc != 1) {
00564         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], NULL);
00565         return TCL_ERROR;
00566     }
00567 
00568     Tcl_AppendResult(interp, Tcl_GetDefaultEncodingDir(), NULL);
00569     return TCL_OK;
00570 }
00571 
00572 /*
00573  *----------------------------------------------------------------------
00574  *
00575  * TestalarmCmd --
00576  *
00577  *      Test that EINTR is handled correctly by generating and handling a
00578  *      signal. This requires using the SA_RESTART flag when registering the
00579  *      signal handler.
00580  *
00581  * Results:
00582  *      None.
00583  *
00584  * Side Effects:
00585  *      Sets up an signal and async handlers.
00586  *
00587  *----------------------------------------------------------------------
00588  */
00589 
00590 static int
00591 TestalarmCmd(
00592     ClientData clientData,      /* Not used. */
00593     Tcl_Interp *interp,         /* Current interpreter. */
00594     int argc,                   /* Number of arguments. */
00595     CONST char **argv)          /* Argument strings. */
00596 {
00597 #ifdef SA_RESTART
00598     unsigned int sec;
00599     struct sigaction action;
00600 
00601     if (argc > 1) {
00602         Tcl_GetInt(interp, argv[1], (int *)&sec);
00603     } else {
00604         sec = 1;
00605     }
00606 
00607     /*
00608      * Setup the signal handling that automatically retries any interrupted
00609      * I/O system calls.
00610      */
00611 
00612     action.sa_handler = AlarmHandler;
00613     memset((void *) &action.sa_mask, 0, sizeof(sigset_t));
00614     action.sa_flags = SA_RESTART;
00615 
00616     if (sigaction(SIGALRM, &action, NULL) < 0) {
00617         Tcl_AppendResult(interp, "sigaction: ", Tcl_PosixError(interp), NULL);
00618         return TCL_ERROR;
00619     }
00620     (void) alarm(sec);
00621     return TCL_OK;
00622 #else
00623     Tcl_AppendResult(interp,
00624             "warning: sigaction SA_RESTART not support on this platform",
00625             NULL);
00626     return TCL_ERROR;
00627 #endif
00628 }
00629 
00630 /*
00631  *----------------------------------------------------------------------
00632  *
00633  * AlarmHandler --
00634  *
00635  *      Signal handler for the alarm command.
00636  *
00637  * Results:
00638  *      None.
00639  *
00640  * Side effects:
00641  *      Calls the Tcl Async handler.
00642  *
00643  *----------------------------------------------------------------------
00644  */
00645 
00646 static void
00647 AlarmHandler(
00648     int signum)
00649 {
00650     gotsig = "1";
00651 }
00652 
00653 /*
00654  *----------------------------------------------------------------------
00655  *
00656  * TestgotsigCmd --
00657  *
00658  *      Verify the signal was handled after the testalarm command.
00659  *
00660  * Results:
00661  *      None.
00662  *
00663  * Side Effects:
00664  *      Resets the value of gotsig back to '0'.
00665  *
00666  *----------------------------------------------------------------------
00667  */
00668 
00669 static int
00670 TestgotsigCmd(
00671     ClientData clientData,      /* Not used. */
00672     Tcl_Interp *interp,         /* Current interpreter. */
00673     int argc,                   /* Number of arguments. */
00674     CONST char **argv)          /* Argument strings. */
00675 {
00676     Tcl_AppendResult(interp, gotsig, NULL);
00677     gotsig = "0";
00678     return TCL_OK;
00679 }
00680 
00681 /*
00682  *---------------------------------------------------------------------------
00683  *
00684  * TestchmodCmd --
00685  *
00686  *      Implements the "testchmod" cmd.  Used when testing "file" command.
00687  *      The only attribute used by the Windows platform is the user write
00688  *      flag; if this is not set, the file is made read-only.  Otehrwise, the
00689  *      file is made read-write.
00690  *
00691  * Results:
00692  *      A standard Tcl result.
00693  *
00694  * Side effects:
00695  *      Changes permissions of specified files.
00696  *
00697  *---------------------------------------------------------------------------
00698  */
00699 
00700 static int
00701 TestchmodCmd(
00702     ClientData dummy,                   /* Not used. */
00703     Tcl_Interp *interp,                 /* Current interpreter. */
00704     int argc,                           /* Number of arguments. */
00705     CONST char **argv)                  /* Argument strings. */
00706 {
00707     int i, mode;
00708     char *rest;
00709 
00710     if (argc < 2) {
00711         usage:
00712         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
00713                 " mode file ?file ...?", NULL);
00714         return TCL_ERROR;
00715     }
00716 
00717     mode = (int) strtol(argv[1], &rest, 8);
00718     if ((rest == argv[1]) || (*rest != '\0')) {
00719         goto usage;
00720     }
00721 
00722     for (i = 2; i < argc; i++) {
00723         Tcl_DString buffer;
00724         CONST char *translated;
00725 
00726         translated = Tcl_TranslateFileName(interp, argv[i], &buffer);
00727         if (translated == NULL) {
00728             return TCL_ERROR;
00729         }
00730         if (chmod(translated, (unsigned) mode) != 0) {
00731             Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
00732                     NULL);
00733             return TCL_ERROR;
00734         }
00735         Tcl_DStringFree(&buffer);
00736     }
00737     return TCL_OK;
00738 }



Generated on Wed Mar 12 12:18:26 2008 by  doxygen 1.5.1