diff options
Diffstat (limited to 'unix/tclUnixTest.c')
| -rw-r--r-- | unix/tclUnixTest.c | 198 |
1 files changed, 101 insertions, 97 deletions
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index ceb64d9..722ded9 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -10,9 +10,6 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#ifndef USE_TCL_STUBS -# define USE_TCL_STUBS -#endif #include "tclInt.h" /* @@ -37,9 +34,9 @@ * exercised by the "testfilehandler" command. */ -typedef struct { - TclFile readFile; /* File handle for reading from the pipe. NULL - * means pipe doesn't exist yet. */ +typedef struct Pipe { + TclFile readFile; /* File handle for reading from the pipe. + * NULL means pipe doesn't exist yet. */ TclFile writeFile; /* File handle for writing from the pipe. */ int readCount; /* Number of times the file handler for this * file has triggered and the file was @@ -62,18 +59,29 @@ static const char *gotsig = "0"; * Forward declarations of functions defined later in this file: */ -static Tcl_CmdProc TestalarmCmd; -static Tcl_ObjCmdProc TestchmodCmd; -static Tcl_CmdProc TestfilehandlerCmd; -static Tcl_CmdProc TestfilewaitCmd; -static Tcl_CmdProc TestfindexecutableCmd; -static Tcl_ObjCmdProc TestforkObjCmd; -static Tcl_ObjCmdProc TestgetencpathObjCmd; -static Tcl_CmdProc TestgetopenfileCmd; -static Tcl_CmdProc TestgotsigCmd; -static Tcl_ObjCmdProc TestsetencpathObjCmd; -static Tcl_FileProc TestFileHandlerProc; -static void AlarmHandler(int signum); +static void TestFileHandlerProc(ClientData clientData, int mask); +static int TestfilehandlerCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestfilewaitCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestfindexecutableCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestforkObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST *argv); +static int TestgetopenfileCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestgetdefencdirCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestsetdefencdirCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +int TclplatformtestInit(Tcl_Interp *interp); +static int TestalarmCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestgotsigCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static void AlarmHandler(int signum); +static int TestchmodCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); /* *---------------------------------------------------------------------- @@ -96,26 +104,26 @@ int TclplatformtestInit( Tcl_Interp *interp) /* Interpreter to add commands to. */ { - Tcl_CreateObjCommand(interp, "testchmod", TestchmodCmd, - NULL, NULL); + Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testfork", TestforkObjCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testgetencpath", TestgetencpathObjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testsetencpath", TestsetencpathObjCmd, - NULL, NULL); + (ClientData) 0, NULL); + Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd, + (ClientData) 0, NULL); + Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd, + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testalarm", TestalarmCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd, - NULL, NULL); + (ClientData) 0, NULL); return TCL_OK; } @@ -141,7 +149,7 @@ TestfilehandlerCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + CONST char **argv) /* Argument strings. */ { Pipe *pipePtr; int i, mask, timeout; @@ -163,7 +171,7 @@ TestfilehandlerCmd( if (argc < 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " option ... \"", NULL); + " option ... \"", NULL); return TCL_ERROR; } pipePtr = NULL; @@ -190,7 +198,7 @@ TestfilehandlerCmd( } else if (strcmp(argv[1], "clear") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " clear index\"", NULL); + argv[0], " clear index\"", NULL); return TCL_ERROR; } pipePtr->readCount = pipePtr->writeCount = 0; @@ -199,15 +207,15 @@ TestfilehandlerCmd( if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " counts index\"", NULL); + argv[0], " counts index\"", NULL); return TCL_ERROR; } sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount); - Tcl_AppendResult(interp, buf, NULL); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if (strcmp(argv[1], "create") == 0) { if (argc != 5) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " create index readMode writeMode\"", NULL); + argv[0], " create index readMode writeMode\"", NULL); return TCL_ERROR; } if (pipePtr->readFile == NULL) { @@ -220,8 +228,8 @@ TestfilehandlerCmd( fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK); fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK); #else - Tcl_AppendResult(interp, "can't make pipes non-blocking", - NULL); + Tcl_SetResult(interp, "can't make pipes non-blocking", + TCL_STATIC); return TCL_ERROR; #endif } @@ -230,24 +238,24 @@ TestfilehandlerCmd( if (strcmp(argv[3], "readable") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->readFile), TCL_READABLE, - TestFileHandlerProc, pipePtr); + TestFileHandlerProc, (ClientData) pipePtr); } else if (strcmp(argv[3], "off") == 0) { Tcl_DeleteFileHandler(GetFd(pipePtr->readFile)); } else if (strcmp(argv[3], "disabled") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->readFile), 0, - TestFileHandlerProc, pipePtr); + TestFileHandlerProc, (ClientData) pipePtr); } else { Tcl_AppendResult(interp, "bad read mode \"", argv[3], "\"", NULL); return TCL_ERROR; } if (strcmp(argv[4], "writable") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), TCL_WRITABLE, - TestFileHandlerProc, pipePtr); + TestFileHandlerProc, (ClientData) pipePtr); } else if (strcmp(argv[4], "off") == 0) { Tcl_DeleteFileHandler(GetFd(pipePtr->writeFile)); } else if (strcmp(argv[4], "disabled") == 0) { Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), 0, - TestFileHandlerProc, pipePtr); + TestFileHandlerProc, (ClientData) pipePtr); } else { Tcl_AppendResult(interp, "bad read mode \"", argv[4], "\"", NULL); return TCL_ERROR; @@ -255,42 +263,42 @@ TestfilehandlerCmd( } else if (strcmp(argv[1], "empty") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " empty index\"", NULL); + argv[0], " empty index\"", NULL); return TCL_ERROR; } while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) { - /* Empty loop body. */ + /* Empty loop body. */ } } else if (strcmp(argv[1], "fill") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " fill index\"", NULL); + argv[0], " fill index\"", NULL); return TCL_ERROR; } memset(buffer, 'a', 4000); while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) { - /* Empty loop body. */ + /* Empty loop body. */ } } else if (strcmp(argv[1], "fillpartial") == 0) { char buf[TCL_INTEGER_SPACE]; if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " fillpartial index\"", NULL); + argv[0], " fillpartial index\"", NULL); return TCL_ERROR; } memset(buffer, 'b', 10); TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10)); - Tcl_AppendResult(interp, buf, NULL); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if (strcmp(argv[1], "oneevent") == 0) { Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT); } else if (strcmp(argv[1], "wait") == 0) { if (argc != 5) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " wait index readable|writable timeout\"", NULL); + argv[0], " wait index readable|writable timeout\"", NULL); return TCL_ERROR; } if (pipePtr->readFile == NULL) { @@ -331,7 +339,7 @@ TestFileHandlerProc( int mask) /* Indicates which events happened: * TCL_READABLE or TCL_WRITABLE. */ { - Pipe *pipePtr = clientData; + Pipe *pipePtr = (Pipe *) clientData; if (mask & TCL_READABLE) { pipePtr->readCount++; @@ -363,7 +371,7 @@ TestfilewaitCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + CONST char **argv) /* Argument strings. */ { int mask, result, timeout; Tcl_Channel channel; @@ -393,7 +401,7 @@ TestfilewaitCmd( if (Tcl_GetChannelHandle(channel, (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE, (ClientData*) &data) != TCL_OK) { - Tcl_AppendResult(interp, "couldn't get channel file", NULL); + Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC); return TCL_ERROR; } fd = PTR2INT(data); @@ -432,7 +440,7 @@ TestfindexecutableCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + CONST char **argv) /* Argument strings. */ { Tcl_Obj *saveName; @@ -475,22 +483,22 @@ TestgetopenfileCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + CONST char **argv) /* Argument strings. */ { ClientData filePtr; if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelName forWriting\"", NULL); + " channelName forWriting\"", NULL); return TCL_ERROR; } if (Tcl_GetOpenFile(interp, argv[1], atoi(argv[2]), 1, &filePtr) - == TCL_ERROR) { + == TCL_ERROR) { return TCL_ERROR; } - if (filePtr == NULL) { + if (filePtr == (ClientData) NULL) { Tcl_AppendResult(interp, - "Tcl_GetOpenFile succeeded but FILE * NULL!", NULL); + "Tcl_GetOpenFile succeeded but FILE * NULL!", NULL); return TCL_ERROR; } return TCL_OK; @@ -499,9 +507,9 @@ TestgetopenfileCmd( /* *---------------------------------------------------------------------- * - * TestsetencpathCmd -- + * TestsetdefencdirCmd -- * - * This function implements the "testsetencpath" command. It is used to + * This function implements the "testsetdefenc" command. It is used to * test Tcl_SetDefaultEncodingDir(). * * Results: @@ -514,18 +522,19 @@ TestgetopenfileCmd( */ static int -TestsetencpathObjCmd( +TestsetdefencdirCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const *objv) /* Argument strings. */ + int argc, /* Number of arguments. */ + CONST char **argv) /* Argument strings. */ { - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "defaultDir"); + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " defaultDir\"", NULL); return TCL_ERROR; } - Tcl_SetEncodingSearchPath(objv[1]); + Tcl_SetDefaultEncodingDir(argv[1]); return TCL_OK; } @@ -551,7 +560,7 @@ TestforkObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *const *objv) /* Argument strings. */ + Tcl_Obj *CONST *objv) /* Argument strings. */ { pid_t pid; @@ -577,10 +586,10 @@ TestforkObjCmd( /* *---------------------------------------------------------------------- * - * TestgetencpathObjCmd -- + * TestgetdefencdirCmd -- * - * This function implements the "testgetencpath" command. It is used to - * test Tcl_GetEncodingSearchPath(). + * This function implements the "testgetdefenc" command. It is used to + * test Tcl_GetDefaultEncodingDir(). * * Results: * A standard Tcl result. @@ -592,18 +601,18 @@ TestforkObjCmd( */ static int -TestgetencpathObjCmd( +TestgetdefencdirCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const *objv) /* Argument strings. */ + int argc, /* Number of arguments. */ + CONST char **argv) /* Argument strings. */ { - if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, ""); + if (argc != 1) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], NULL); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath()); + Tcl_AppendResult(interp, Tcl_GetDefaultEncodingDir(), NULL); return TCL_OK; } @@ -630,7 +639,7 @@ TestalarmCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + CONST char **argv) /* Argument strings. */ { #ifdef SA_RESTART unsigned int sec; @@ -709,7 +718,7 @@ TestgotsigCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + CONST char **argv) /* Argument strings. */ { Tcl_AppendResult(interp, gotsig, NULL); gotsig = "0"; @@ -739,25 +748,29 @@ static int TestchmodCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const *objv) /* Argument strings. */ + int argc, /* Number of arguments. */ + CONST char **argv) /* Argument strings. */ { int i, mode; + char *rest; - if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?"); + if (argc < 2) { + usage: + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " mode file ?file ...?", NULL); return TCL_ERROR; } - if (Tcl_GetIntFromObj(interp, objv[1], &mode) != TCL_OK) { - return TCL_ERROR; + mode = (int) strtol(argv[1], &rest, 8); + if ((rest == argv[1]) || (*rest != '\0')) { + goto usage; } - for (i = 2; i < objc; i++) { + for (i = 2; i < argc; i++) { Tcl_DString buffer; - const char *translated; + CONST char *translated; - translated = Tcl_TranslateFileName(interp, Tcl_GetString(objv[i]), &buffer); + translated = Tcl_TranslateFileName(interp, argv[i], &buffer); if (translated == NULL) { return TCL_ERROR; } @@ -770,12 +783,3 @@ TestchmodCmd( } return TCL_OK; } - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * tab-width: 8 - * End: - */ |