summaryrefslogtreecommitdiffstats
path: root/unix/tclUnixTest.c
diff options
context:
space:
mode:
Diffstat (limited to 'unix/tclUnixTest.c')
-rw-r--r--unix/tclUnixTest.c441
1 files changed, 287 insertions, 154 deletions
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c
index 515f234..722ded9 100644
--- a/unix/tclUnixTest.c
+++ b/unix/tclUnixTest.c
@@ -3,16 +3,13 @@
*
* Contains platform specific test commands for the Unix platform.
*
- * Copyright © 1996-1997 Sun Microsystems, Inc.
- * Copyright © 1998 Scriptics Corporation.
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution of
* 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,15 +59,29 @@ static const char *gotsig = "0";
* Forward declarations of functions defined later in this file:
*/
-static Tcl_ObjCmdProc TestalarmCmd;
-static Tcl_ObjCmdProc TestchmodCmd;
-static Tcl_ObjCmdProc TestfilehandlerCmd;
-static Tcl_ObjCmdProc TestfilewaitCmd;
-static Tcl_ObjCmdProc TestfindexecutableCmd;
-static Tcl_ObjCmdProc TestforkCmd;
-static Tcl_ObjCmdProc TestgotsigCmd;
-static Tcl_FileProc TestFileHandlerProc;
+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);
/*
*----------------------------------------------------------------------
@@ -93,20 +104,26 @@ int
TclplatformtestInit(
Tcl_Interp *interp) /* Interpreter to add commands to. */
{
- Tcl_CreateObjCommand(interp, "testchmod", TestchmodCmd,
- NULL, NULL);
- Tcl_CreateObjCommand(interp, "testfilehandler", TestfilehandlerCmd,
- NULL, NULL);
- Tcl_CreateObjCommand(interp, "testfilewait", TestfilewaitCmd,
- NULL, NULL);
- Tcl_CreateObjCommand(interp, "testfindexecutable", TestfindexecutableCmd,
- NULL, NULL);
- Tcl_CreateObjCommand(interp, "testfork", TestforkCmd,
- NULL, NULL);
- Tcl_CreateObjCommand(interp, "testalarm", TestalarmCmd,
- NULL, NULL);
- Tcl_CreateObjCommand(interp, "testgotsig", TestgotsigCmd,
- NULL, NULL);
+ Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
+ (ClientData) 0, NULL);
+ Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd,
+ (ClientData) 0, NULL);
+ Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd,
+ (ClientData) 0, NULL);
+ Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
+ (ClientData) 0, NULL);
+ Tcl_CreateObjCommand(interp, "testfork", TestforkObjCmd,
+ (ClientData) 0, NULL);
+ Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
+ (ClientData) 0, NULL);
+ Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd,
+ (ClientData) 0, NULL);
+ Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd,
+ (ClientData) 0, NULL);
+ Tcl_CreateCommand(interp, "testalarm", TestalarmCmd,
+ (ClientData) 0, NULL);
+ Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd,
+ (ClientData) 0, NULL);
return TCL_OK;
}
@@ -129,10 +146,10 @@ TclplatformtestInit(
static int
TestfilehandlerCmd(
- TCL_UNUSED(void *),
+ 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. */
{
Pipe *pipePtr;
int i, mask, timeout;
@@ -152,23 +169,24 @@ TestfilehandlerCmd(
initialized = 1;
}
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option ...");
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+ " option ... \"", NULL);
return TCL_ERROR;
}
pipePtr = NULL;
- if (objc >= 3) {
- if (Tcl_GetIntFromObj(interp, objv[2], &i) != TCL_OK) {
+ if (argc >= 3) {
+ if (Tcl_GetInt(interp, argv[2], &i) != TCL_OK) {
return TCL_ERROR;
}
if (i >= MAX_PIPES) {
- Tcl_AppendResult(interp, "bad index ", objv[2], (void *)NULL);
+ Tcl_AppendResult(interp, "bad index ", argv[2], NULL);
return TCL_ERROR;
}
pipePtr = &testPipes[i];
}
- if (strcmp(Tcl_GetString(objv[1]), "close") == 0) {
+ if (strcmp(argv[1], "close") == 0) {
for (i = 0; i < MAX_PIPES; i++) {
if (testPipes[i].readFile != NULL) {
TclpCloseFile(testPipes[i].readFile);
@@ -177,117 +195,124 @@ TestfilehandlerCmd(
testPipes[i].writeFile = NULL;
}
}
- } else if (strcmp(Tcl_GetString(objv[1]), "clear") == 0) {
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "index");
+ } else if (strcmp(argv[1], "clear") == 0) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"",
+ argv[0], " clear index\"", NULL);
return TCL_ERROR;
}
pipePtr->readCount = pipePtr->writeCount = 0;
- } else if (strcmp(Tcl_GetString(objv[1]), "counts") == 0) {
+ } else if (strcmp(argv[1], "counts") == 0) {
char buf[TCL_INTEGER_SPACE * 2];
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "index");
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"",
+ argv[0], " counts index\"", NULL);
return TCL_ERROR;
}
- snprintf(buf, sizeof(buf), "%d %d", pipePtr->readCount, pipePtr->writeCount);
- Tcl_AppendResult(interp, buf, (void *)NULL);
- } else if (strcmp(Tcl_GetString(objv[1]), "create") == 0) {
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "index readMode writeMode");
+ sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount);
+ 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);
return TCL_ERROR;
}
if (pipePtr->readFile == NULL) {
if (!TclpCreatePipe(&pipePtr->readFile, &pipePtr->writeFile)) {
Tcl_AppendResult(interp, "couldn't open pipe: ",
- Tcl_PosixError(interp), (void *)NULL);
+ Tcl_PosixError(interp), NULL);
return TCL_ERROR;
}
#ifdef O_NONBLOCK
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",
- (void *)NULL);
+ Tcl_SetResult(interp, "can't make pipes non-blocking",
+ TCL_STATIC);
return TCL_ERROR;
#endif
}
pipePtr->readCount = 0;
pipePtr->writeCount = 0;
- if (strcmp(Tcl_GetString(objv[3]), "readable") == 0) {
+ if (strcmp(argv[3], "readable") == 0) {
Tcl_CreateFileHandler(GetFd(pipePtr->readFile), TCL_READABLE,
- TestFileHandlerProc, pipePtr);
- } else if (strcmp(Tcl_GetString(objv[3]), "off") == 0) {
+ TestFileHandlerProc, (ClientData) pipePtr);
+ } else if (strcmp(argv[3], "off") == 0) {
Tcl_DeleteFileHandler(GetFd(pipePtr->readFile));
- } else if (strcmp(Tcl_GetString(objv[3]), "disabled") == 0) {
+ } 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 \"", Tcl_GetString(objv[3]), "\"", (void *)NULL);
+ Tcl_AppendResult(interp, "bad read mode \"", argv[3], "\"", NULL);
return TCL_ERROR;
}
- if (strcmp(Tcl_GetString(objv[4]), "writable") == 0) {
+ if (strcmp(argv[4], "writable") == 0) {
Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), TCL_WRITABLE,
- TestFileHandlerProc, pipePtr);
- } else if (strcmp(Tcl_GetString(objv[4]), "off") == 0) {
+ TestFileHandlerProc, (ClientData) pipePtr);
+ } else if (strcmp(argv[4], "off") == 0) {
Tcl_DeleteFileHandler(GetFd(pipePtr->writeFile));
- } else if (strcmp(Tcl_GetString(objv[4]), "disabled") == 0) {
+ } 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 \"", Tcl_GetString(objv[4]), "\"", (void *)NULL);
+ Tcl_AppendResult(interp, "bad read mode \"", argv[4], "\"", NULL);
return TCL_ERROR;
}
- } else if (strcmp(Tcl_GetString(objv[1]), "empty") == 0) {
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "index");
+ } else if (strcmp(argv[1], "empty") == 0) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"",
+ 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(Tcl_GetString(objv[1]), "fill") == 0) {
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "index");
+ } else if (strcmp(argv[1], "fill") == 0) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"",
+ argv[0], " fill index\"", NULL);
return TCL_ERROR;
}
memset(buffer, 'a', 4000);
- while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) {
- /* Empty loop body. */
- }
- } else if (strcmp(Tcl_GetString(objv[1]), "fillpartial") == 0) {
+ while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) {
+ /* Empty loop body. */
+ }
+ } else if (strcmp(argv[1], "fillpartial") == 0) {
char buf[TCL_INTEGER_SPACE];
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "index");
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"",
+ argv[0], " fillpartial index\"", NULL);
return TCL_ERROR;
}
memset(buffer, 'b', 10);
TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10));
- Tcl_AppendResult(interp, buf, (void *)NULL);
- } else if (strcmp(Tcl_GetString(objv[1]), "oneevent") == 0) {
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ } else if (strcmp(argv[1], "oneevent") == 0) {
Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT);
- } else if (strcmp(Tcl_GetString(objv[1]), "wait") == 0) {
- if (objc != 5) {
- Tcl_WrongNumArgs(interp, 2, objv, "index readable|writable timeout");
+ } 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);
return TCL_ERROR;
}
if (pipePtr->readFile == NULL) {
- Tcl_AppendResult(interp, "pipe ", Tcl_GetString(objv[2]), " doesn't exist", (void *)NULL);
+ Tcl_AppendResult(interp, "pipe ", argv[2], " doesn't exist", NULL);
return TCL_ERROR;
}
- if (strcmp(Tcl_GetString(objv[3]), "readable") == 0) {
+ if (strcmp(argv[3], "readable") == 0) {
mask = TCL_READABLE;
file = pipePtr->readFile;
} else {
mask = TCL_WRITABLE;
file = pipePtr->writeFile;
}
- if (Tcl_GetIntFromObj(interp, objv[4], &timeout) != TCL_OK) {
+ if (Tcl_GetInt(interp, argv[4], &timeout) != TCL_OK) {
return TCL_ERROR;
}
i = TclUnixWaitForFile(GetFd(file), mask, timeout);
@@ -297,12 +322,12 @@ TestfilehandlerCmd(
if (i & TCL_WRITABLE) {
Tcl_AppendElement(interp, "writable");
}
- } else if (strcmp(Tcl_GetString(objv[1]), "windowevent") == 0) {
+ } else if (strcmp(argv[1], "windowevent") == 0) {
Tcl_DoOneEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT);
} else {
- Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]),
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
"\": must be close, clear, counts, create, empty, fill, "
- "fillpartial, oneevent, wait, or windowevent", (void *)NULL);
+ "fillpartial, oneevent, wait, or windowevent", NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -310,11 +335,11 @@ TestfilehandlerCmd(
static void
TestFileHandlerProc(
- void *clientData, /* Points to a Pipe structure. */
+ ClientData clientData, /* Points to a Pipe structure. */
int mask) /* Indicates which events happened:
* TCL_READABLE or TCL_WRITABLE. */
{
- Pipe *pipePtr = (Pipe *)clientData;
+ Pipe *pipePtr = (Pipe *) clientData;
if (mask & TCL_READABLE) {
pipePtr->readCount++;
@@ -343,43 +368,44 @@ TestFileHandlerProc(
static int
TestfilewaitCmd(
- TCL_UNUSED(void *),
+ 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. */
{
int mask, result, timeout;
Tcl_Channel channel;
int fd;
- void *data;
+ ClientData data;
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "file readable|writable|both timeout");
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+ " file readable|writable|both timeout\"", NULL);
return TCL_ERROR;
}
- channel = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
+ channel = Tcl_GetChannel(interp, argv[1], NULL);
if (channel == NULL) {
return TCL_ERROR;
}
- if (strcmp(Tcl_GetString(objv[2]), "readable") == 0) {
+ if (strcmp(argv[2], "readable") == 0) {
mask = TCL_READABLE;
- } else if (strcmp(Tcl_GetString(objv[2]), "writable") == 0){
+ } else if (strcmp(argv[2], "writable") == 0){
mask = TCL_WRITABLE;
- } else if (strcmp(Tcl_GetString(objv[2]), "both") == 0){
+ } else if (strcmp(argv[2], "both") == 0){
mask = TCL_WRITABLE|TCL_READABLE;
} else {
- Tcl_AppendResult(interp, "bad argument \"", Tcl_GetString(objv[2]),
- "\": must be readable, writable, or both", (void *)NULL);
+ Tcl_AppendResult(interp, "bad argument \"", argv[2],
+ "\": must be readable, writable, or both", NULL);
return TCL_ERROR;
}
if (Tcl_GetChannelHandle(channel,
(mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE,
- (void **) &data) != TCL_OK) {
- Tcl_AppendResult(interp, "couldn't get channel file", (void *)NULL);
+ (ClientData*) &data) != TCL_OK) {
+ Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC);
return TCL_ERROR;
}
fd = PTR2INT(data);
- if (Tcl_GetIntFromObj(interp, objv[3], &timeout) != TCL_OK) {
+ if (Tcl_GetInt(interp, argv[3], &timeout) != TCL_OK) {
return TCL_ERROR;
}
result = TclUnixWaitForFile(fd, mask, timeout);
@@ -411,22 +437,23 @@ TestfilewaitCmd(
static int
TestfindexecutableCmd(
- TCL_UNUSED(void *),
+ 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. */
{
Tcl_Obj *saveName;
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "argv0");
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+ " argv0\"", NULL);
return TCL_ERROR;
}
saveName = TclGetObjNameOfExecutable();
Tcl_IncrRefCount(saveName);
- TclpFindExecutable(Tcl_GetString(objv[1]));
+ TclpFindExecutable(argv[1]);
Tcl_SetObjResult(interp, TclGetObjNameOfExecutable());
TclSetObjNameOfExecutable(saveName, NULL);
@@ -437,7 +464,84 @@ TestfindexecutableCmd(
/*
*----------------------------------------------------------------------
*
- * TestforkCmd --
+ * TestgetopenfileCmd --
+ *
+ * This function implements the "testgetopenfile" command. It is used to
+ * get a FILE * value from a registered channel.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestgetopenfileCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ CONST char **argv) /* Argument strings. */
+{
+ ClientData filePtr;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " channelName forWriting\"", NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetOpenFile(interp, argv[1], atoi(argv[2]), 1, &filePtr)
+ == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (filePtr == (ClientData) NULL) {
+ Tcl_AppendResult(interp,
+ "Tcl_GetOpenFile succeeded but FILE * NULL!", NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestsetdefencdirCmd --
+ *
+ * This function implements the "testsetdefenc" command. It is used to
+ * test Tcl_SetDefaultEncodingDir().
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestsetdefencdirCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ CONST char **argv) /* Argument strings. */
+{
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " 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.
@@ -452,11 +556,11 @@ TestfindexecutableCmd(
*/
static int
-TestforkCmd(
- TCL_UNUSED(void *),
+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;
@@ -467,7 +571,7 @@ TestforkCmd(
pid = fork();
if (pid == -1) {
Tcl_AppendResult(interp,
- "Cannot fork", (void *)NULL);
+ "Cannot fork", NULL);
return TCL_ERROR;
}
/* Only needed when pthread_atfork is not present,
@@ -475,7 +579,40 @@ TestforkCmd(
if (pid==0) {
Tcl_InitNotifier();
}
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj(pid));
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(pid));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestgetdefencdirCmd --
+ *
+ * This function implements the "testgetdefenc" command. It is used to
+ * test Tcl_GetDefaultEncodingDir().
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestgetdefencdirCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int argc, /* Number of arguments. */
+ CONST char **argv) /* Argument strings. */
+{
+ if (argc != 1) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_AppendResult(interp, Tcl_GetDefaultEncodingDir(), NULL);
return TCL_OK;
}
@@ -499,17 +636,19 @@ TestforkCmd(
static int
TestalarmCmd(
- TCL_UNUSED(void *),
+ 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. */
{
#ifdef SA_RESTART
- unsigned int sec = 1;
+ unsigned int sec;
struct sigaction action;
- if (objc > 1) {
- Tcl_GetIntFromObj(interp, objv[1], (int *)&sec);
+ if (argc > 1) {
+ Tcl_GetInt(interp, argv[1], (int *)&sec);
+ } else {
+ sec = 1;
}
/*
@@ -522,16 +661,15 @@ TestalarmCmd(
action.sa_flags = SA_RESTART;
if (sigaction(SIGALRM, &action, NULL) < 0) {
- Tcl_AppendResult(interp, "sigaction: ", Tcl_PosixError(interp), (void *)NULL);
+ Tcl_AppendResult(interp, "sigaction: ", Tcl_PosixError(interp), NULL);
return TCL_ERROR;
}
(void) alarm(sec);
return TCL_OK;
#else
-
Tcl_AppendResult(interp,
"warning: sigaction SA_RESTART not support on this platform",
- (void *)NULL);
+ NULL);
return TCL_ERROR;
#endif
}
@@ -554,7 +692,7 @@ TestalarmCmd(
static void
AlarmHandler(
- TCL_UNUSED(int) /*signum*/)
+ int signum)
{
gotsig = "1";
}
@@ -577,12 +715,12 @@ AlarmHandler(
static int
TestgotsigCmd(
- TCL_UNUSED(void *),
+ ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
- TCL_UNUSED(int) /*objc*/,
- TCL_UNUSED(Tcl_Obj *const *))
+ int argc, /* Number of arguments. */
+ CONST char **argv) /* Argument strings. */
{
- Tcl_AppendResult(interp, gotsig, (void *)NULL);
+ Tcl_AppendResult(interp, gotsig, NULL);
gotsig = "0";
return TCL_OK;
}
@@ -594,7 +732,7 @@ TestgotsigCmd(
*
* 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. Otherwise, the
+ * flag; if this is not set, the file is made read-only. Otehrwise, the
* file is made read-write.
*
* Results:
@@ -608,45 +746,40 @@ TestgotsigCmd(
static int
TestchmodCmd(
- TCL_UNUSED(void *),
+ 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;
}
- if (chmod(translated, mode) != 0) {
+ if (chmod(translated, (unsigned) mode) != 0) {
Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
- (void *)NULL);
+ NULL);
return TCL_ERROR;
}
Tcl_DStringFree(&buffer);
}
return TCL_OK;
}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * tab-width: 8
- * End:
- */
generated by cgit v0.12 at 2025-12-21 16:41:55 (GMT)