summaryrefslogtreecommitdiffstats
path: root/unix/tclUnixTest.c
diff options
context:
space:
mode:
Diffstat (limited to 'unix/tclUnixTest.c')
-rw-r--r--unix/tclUnixTest.c210
1 files changed, 129 insertions, 81 deletions
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c
index 1110b07..4b0f369 100644
--- a/unix/tclUnixTest.c
+++ b/unix/tclUnixTest.c
@@ -8,10 +8,11 @@
*
* 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.22 2006/03/14 19:34:30 vincentdarley Exp $
*/
+#ifndef USE_TCL_STUBS
+# define USE_TCL_STUBS
+#endif
#include "tclInt.h"
/*
@@ -28,8 +29,8 @@
* the same as NULL. Note that this code is duplicated from tclUnixPipe.c
*/
-#define MakeFile(fd) ((TclFile)((fd)+1))
-#define GetFd(file) (((int)file)-1)
+#define MakeFile(fd) ((TclFile)INT2PTR(((int)(fd))+1))
+#define GetFd(file) (PTR2INT(file)-1)
/*
* The stuff below is used to keep track of file handlers created and
@@ -37,8 +38,8 @@
*/
typedef struct Pipe {
- TclFile readFile; /* File handle for reading from the pipe.
- * NULL means pipe doesn't exist yet. */
+ 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
@@ -55,33 +56,24 @@ static Pipe testPipes[MAX_PIPES];
* The stuff below is used by the testalarm and testgotsig ommands.
*/
-static char *gotsig = "0";
+static const char *gotsig = "0";
/*
* Forward declarations of functions defined later in this file:
*/
-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 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);
+static Tcl_CmdProc TestalarmCmd;
+static Tcl_CmdProc TestchmodCmd;
+static Tcl_CmdProc TestfilehandlerCmd;
+static Tcl_CmdProc TestfilewaitCmd;
+static Tcl_CmdProc TestfindexecutableCmd;
+static Tcl_ObjCmdProc TestforkObjCmd;
+static Tcl_CmdProc TestgetdefencdirCmd;
+static Tcl_CmdProc TestgetopenfileCmd;
+static Tcl_CmdProc TestgotsigCmd;
+static Tcl_CmdProc TestsetdefencdirCmd;
+static Tcl_FileProc TestFileHandlerProc;
+static void AlarmHandler(int signum);
/*
*----------------------------------------------------------------------
@@ -105,23 +97,25 @@ TclplatformtestInit(
Tcl_Interp *interp) /* Interpreter to add commands to. */
{
Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testfork", TestforkObjCmd,
+ NULL, NULL);
Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testalarm", TestalarmCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
return TCL_OK;
}
@@ -147,7 +141,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;
@@ -169,7 +163,7 @@ TestfilehandlerCmd(
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
- " option ... \"", NULL);
+ " option ... \"", NULL);
return TCL_ERROR;
}
pipePtr = NULL;
@@ -196,7 +190,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;
@@ -205,15 +199,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_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_AppendResult(interp, buf, NULL);
} 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) {
@@ -226,8 +220,8 @@ TestfilehandlerCmd(
fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK);
fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK);
#else
- Tcl_SetResult(interp, "can't make pipes non-blocking",
- TCL_STATIC);
+ Tcl_AppendResult(interp, "can't make pipes non-blocking",
+ NULL);
return TCL_ERROR;
#endif
}
@@ -236,24 +230,24 @@ TestfilehandlerCmd(
if (strcmp(argv[3], "readable") == 0) {
Tcl_CreateFileHandler(GetFd(pipePtr->readFile), TCL_READABLE,
- TestFileHandlerProc, (ClientData) pipePtr);
+ TestFileHandlerProc, 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, (ClientData) pipePtr);
+ TestFileHandlerProc, 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, (ClientData) pipePtr);
+ TestFileHandlerProc, 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, (ClientData) pipePtr);
+ TestFileHandlerProc, pipePtr);
} else {
Tcl_AppendResult(interp, "bad read mode \"", argv[4], "\"", NULL);
return TCL_ERROR;
@@ -261,42 +255,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((VOID *) buffer, 'a', 4000);
+ 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((VOID *) buffer, 'b', 10);
+ memset(buffer, 'b', 10);
TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10));
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_AppendResult(interp, buf, NULL);
} 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) {
@@ -324,7 +318,7 @@ TestfilehandlerCmd(
Tcl_DoOneEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT);
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
- "\": must be close, clear, counts, create, empty, fill, ",
+ "\": must be close, clear, counts, create, empty, fill, "
"fillpartial, oneevent, wait, or windowevent", NULL);
return TCL_ERROR;
}
@@ -337,7 +331,7 @@ TestFileHandlerProc(
int mask) /* Indicates which events happened:
* TCL_READABLE or TCL_WRITABLE. */
{
- Pipe *pipePtr = (Pipe *) clientData;
+ Pipe *pipePtr = clientData;
if (mask & TCL_READABLE) {
pipePtr->readCount++;
@@ -369,7 +363,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;
@@ -399,10 +393,10 @@ TestfilewaitCmd(
if (Tcl_GetChannelHandle(channel,
(mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE,
(ClientData*) &data) != TCL_OK) {
- Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC);
+ Tcl_AppendResult(interp, "couldn't get channel file", NULL);
return TCL_ERROR;
}
- fd = (int) data;
+ fd = PTR2INT(data);
if (Tcl_GetInt(interp, argv[3], &timeout) != TCL_OK) {
return TCL_ERROR;
}
@@ -438,7 +432,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;
@@ -481,22 +475,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 == (ClientData) NULL) {
+ if (filePtr == NULL) {
Tcl_AppendResult(interp,
- "Tcl_GetOpenFile succeeded but FILE * NULL!", NULL);
+ "Tcl_GetOpenFile succeeded but FILE * NULL!", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -524,17 +518,62 @@ TestsetdefencdirCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
- CONST char **argv) /* Argument strings. */
+ const char **argv) /* Argument strings. */
{
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " defaultDir\"", NULL);
+ " defaultDir\"", NULL);
return TCL_ERROR;
}
Tcl_SetDefaultEncodingDir(argv[1]);
return TCL_OK;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestforkObjCmd --
+ *
+ * This function implements the "testfork" command. It is used to
+ * fork the Tcl process for specific test cases.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestforkObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const *objv) /* Argument strings. */
+{
+ pid_t pid;
+
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "");
+ return TCL_ERROR;
+ }
+ pid = fork();
+ if (pid == -1) {
+ Tcl_AppendResult(interp,
+ "Cannot fork", NULL);
+ return TCL_ERROR;
+ }
+ /* Only needed when pthread_atfork is not present,
+ * should not hurt otherwise. */
+ if (pid==0) {
+ Tcl_InitNotifier();
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(pid));
+ return TCL_OK;
+}
/*
*----------------------------------------------------------------------
@@ -558,7 +597,7 @@ TestgetdefencdirCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
- CONST char **argv) /* Argument strings. */
+ const char **argv) /* Argument strings. */
{
if (argc != 1) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], NULL);
@@ -592,7 +631,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;
@@ -671,7 +710,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";
@@ -698,17 +737,17 @@ TestgotsigCmd(
*/
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. */
+TestchmodCmd(
+ 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:
+ usage:
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" mode file ?file ...?", NULL);
return TCL_ERROR;
@@ -721,7 +760,7 @@ TestchmodCmd(dummy, interp, argc, argv)
for (i = 2; i < argc; i++) {
Tcl_DString buffer;
- CONST char *translated;
+ const char *translated;
translated = Tcl_TranslateFileName(interp, argv[i], &buffer);
if (translated == NULL) {
@@ -736,3 +775,12 @@ TestchmodCmd(dummy, interp, argc, argv)
}
return TCL_OK;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * tab-width: 8
+ * End:
+ */