sl@0: /* 
sl@0:  * tclUnixTest.c --
sl@0:  *
sl@0:  *	Contains platform specific test commands for the Unix platform.
sl@0:  *
sl@0:  * Copyright (c) 1996-1997 Sun Microsystems, Inc.
sl@0:  * Copyright (c) 1998 by Scriptics Corporation.
sl@0:  * Portions Copyright (c) 2007 Nokia Corporation and/or its subsidiaries. All rights reserved.   
sl@0:  *
sl@0:  * See the file "license.terms" for information on usage and redistribution
sl@0:  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0:  *
sl@0:  * RCS: @(#) $Id: tclUnixTest.c,v 1.14.2.2 2006/03/19 22:47:30 vincentdarley Exp $
sl@0:  */
sl@0: 
sl@0: #include "tclInt.h"
sl@0: #include "tclPort.h"
sl@0: #if defined(__SYMBIAN32__) 
sl@0: #include "tclSymbianGlobals.h"
sl@0: #endif 
sl@0: 
sl@0: /*
sl@0:  * The headers are needed for the testalarm command that verifies the
sl@0:  * use of SA_RESTART in signal handlers.
sl@0:  */
sl@0: 
sl@0: #ifndef __SYMBIAN32__  
sl@0: #include <signal.h>
sl@0: #endif
sl@0: #include <sys/resource.h>
sl@0: 
sl@0: /*
sl@0:  * The following macros convert between TclFile's and fd's.  The conversion
sl@0:  * simple involves shifting fd's up by one to ensure that no valid fd is ever
sl@0:  * the same as NULL.  Note that this code is duplicated from tclUnixPipe.c
sl@0:  */
sl@0: 
sl@0: #define MakeFile(fd) ((TclFile)((fd)+1))
sl@0: #define GetFd(file) (((int)file)-1)
sl@0: 
sl@0: /*
sl@0:  * The stuff below is used to keep track of file handlers created and
sl@0:  * exercised by the "testfilehandler" command.
sl@0:  */
sl@0: 
sl@0: typedef struct Pipe {
sl@0:     TclFile readFile;		/* File handle for reading from the
sl@0: 				 * pipe.  NULL means pipe doesn't exist yet. */
sl@0:     TclFile writeFile;		/* File handle for writing from the
sl@0: 				 * pipe. */
sl@0:     int readCount;		/* Number of times the file handler for
sl@0: 				 * this file has triggered and the file
sl@0: 				 * was readable. */
sl@0:     int writeCount;		/* Number of times the file handler for
sl@0: 				 * this file has triggered and the file
sl@0: 				 * was writable. */
sl@0: } Pipe;
sl@0: 
sl@0: #define MAX_PIPES 10
sl@0: static Pipe testPipes[MAX_PIPES];
sl@0: 
sl@0: /*
sl@0:  * The stuff below is used by the testalarm and testgotsig ommands.
sl@0:  */
sl@0: 
sl@0: static char *gotsig = "0";
sl@0: 
sl@0: /*
sl@0:  * Forward declarations of procedures defined later in this file:
sl@0:  */
sl@0: 
sl@0: static void		TestFileHandlerProc _ANSI_ARGS_((ClientData clientData,
sl@0: 			    int mask));
sl@0: static int		TestfilehandlerCmd _ANSI_ARGS_((ClientData dummy,
sl@0: 			    Tcl_Interp *interp, int argc, CONST char **argv));
sl@0: static int		TestfilewaitCmd _ANSI_ARGS_((ClientData dummy,
sl@0: 			    Tcl_Interp *interp, int argc, CONST char **argv));
sl@0: static int		TestfindexecutableCmd _ANSI_ARGS_((ClientData dummy,
sl@0: 			    Tcl_Interp *interp, int argc, CONST char **argv));
sl@0: static int		TestgetopenfileCmd _ANSI_ARGS_((ClientData dummy,
sl@0: 			    Tcl_Interp *interp, int argc, CONST char **argv));
sl@0: static int		TestgetdefencdirCmd _ANSI_ARGS_((ClientData dummy,
sl@0: 			    Tcl_Interp *interp, int argc, CONST char **argv));
sl@0: static int		TestsetdefencdirCmd _ANSI_ARGS_((ClientData dummy,
sl@0: 			    Tcl_Interp *interp, int argc, CONST char **argv));
sl@0: int			TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
sl@0: static int		TestalarmCmd _ANSI_ARGS_((ClientData dummy,
sl@0: 			    Tcl_Interp *interp, int argc, CONST char **argv));
sl@0: static int		TestgotsigCmd _ANSI_ARGS_((ClientData dummy,
sl@0: 			    Tcl_Interp *interp, int argc, CONST char **argv));
sl@0: static void 		AlarmHandler _ANSI_ARGS_(());
sl@0: static int		TestchmodCmd _ANSI_ARGS_((ClientData dummy,
sl@0: 			    Tcl_Interp *interp, int argc, CONST char **argv));
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclplatformtestInit --
sl@0:  *
sl@0:  *	Defines commands that test platform specific functionality for
sl@0:  *	Unix platforms.
sl@0:  *
sl@0:  * Results:
sl@0:  *	A standard Tcl result.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Defines new commands.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int
sl@0: TclplatformtestInit(interp)
sl@0:     Tcl_Interp *interp;		/* Interpreter to add commands to. */
sl@0: {
sl@0:     Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
sl@0: 	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
sl@0:     Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd,
sl@0:             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
sl@0:     Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd,
sl@0:             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
sl@0:     Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
sl@0:             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
sl@0:     Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
sl@0:             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
sl@0:     Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd,
sl@0:             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
sl@0:     Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd,
sl@0:             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
sl@0: #ifndef __SYMBIAN32__            
sl@0:  // Symbian and PIPS don't support signals.           
sl@0:     Tcl_CreateCommand(interp, "testalarm", TestalarmCmd,
sl@0:             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
sl@0: #endif
sl@0:     Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd,
sl@0:             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TestfilehandlerCmd --
sl@0:  *
sl@0:  *	This procedure implements the "testfilehandler" command. It is
sl@0:  *	used to test Tcl_CreateFileHandler, Tcl_DeleteFileHandler, and
sl@0:  *	TclWaitForFile.
sl@0:  *
sl@0:  * Results:
sl@0:  *	A standard Tcl result.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: TestfilehandlerCmd(clientData, interp, argc, argv)
sl@0:     ClientData clientData;		/* Not used. */
sl@0:     Tcl_Interp *interp;			/* Current interpreter. */
sl@0:     int argc;				/* Number of arguments. */
sl@0:     CONST char **argv;			/* Argument strings. */
sl@0: {
sl@0:     Pipe *pipePtr;
sl@0:     int i, mask, timeout;
sl@0:     static int initialized = 0;
sl@0:     char buffer[4000];
sl@0:     TclFile file;
sl@0: 
sl@0:     /*
sl@0:      * NOTE: When we make this code work on Windows also, the following
sl@0:      * variable needs to be made Unix-only.
sl@0:      */
sl@0:     
sl@0:     if (!initialized) {
sl@0: 	for (i = 0; i < MAX_PIPES; i++) {
sl@0: 	    testPipes[i].readFile = NULL;
sl@0: 	}
sl@0: 	initialized = 1;
sl@0:     }
sl@0: 
sl@0:     if (argc < 2) {
sl@0: 	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
sl@0:                 " option ... \"", (char *) NULL);
sl@0:         return TCL_ERROR;
sl@0:     }
sl@0:     pipePtr = NULL;
sl@0:     if (argc >= 3) {
sl@0: 	if (Tcl_GetInt(interp, argv[2], &i) != TCL_OK) {
sl@0: 	    return TCL_ERROR;
sl@0: 	}
sl@0: 	if (i >= MAX_PIPES) {
sl@0: 	    Tcl_AppendResult(interp, "bad index ", argv[2], (char *) NULL);
sl@0: 	    return TCL_ERROR;
sl@0: 	}
sl@0: 	pipePtr = &testPipes[i];
sl@0:     }
sl@0: 
sl@0:     if (strcmp(argv[1], "close") == 0) {
sl@0: 	for (i = 0; i < MAX_PIPES; i++) {
sl@0: 	    if (testPipes[i].readFile != NULL) {
sl@0: 		TclpCloseFile(testPipes[i].readFile);
sl@0: 		testPipes[i].readFile = NULL;
sl@0: 		TclpCloseFile(testPipes[i].writeFile);
sl@0: 		testPipes[i].writeFile = NULL;
sl@0: 	    }
sl@0: 	}
sl@0:     } else if (strcmp(argv[1], "clear") == 0) {
sl@0: 	if (argc != 3) {
sl@0: 	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
sl@0:                     argv[0], " clear index\"", (char *) NULL);
sl@0: 	    return TCL_ERROR;
sl@0: 	}
sl@0: 	pipePtr->readCount = pipePtr->writeCount = 0;
sl@0:     } else if (strcmp(argv[1], "counts") == 0) {
sl@0: 	char buf[TCL_INTEGER_SPACE * 2];
sl@0: 	
sl@0: 	if (argc != 3) {
sl@0: 	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
sl@0:                     argv[0], " counts index\"", (char *) NULL);
sl@0: 	    return TCL_ERROR;
sl@0: 	}
sl@0: 	sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount);
sl@0: 	Tcl_SetResult(interp, buf, TCL_VOLATILE);
sl@0:     } else if (strcmp(argv[1], "create") == 0) {
sl@0: 	if (argc != 5) {
sl@0: 	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
sl@0:                     argv[0], " create index readMode writeMode\"",
sl@0:                     (char *) NULL);
sl@0: 	    return TCL_ERROR;
sl@0: 	}
sl@0: 	if (pipePtr->readFile == NULL) {
sl@0: 	    if (!TclpCreatePipe(&pipePtr->readFile, &pipePtr->writeFile)) {
sl@0: 		Tcl_AppendResult(interp, "couldn't open pipe: ",
sl@0: 			Tcl_PosixError(interp), (char *) NULL);
sl@0: 		return TCL_ERROR;
sl@0: 	    }
sl@0: #ifdef O_NONBLOCK
sl@0: 	    fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK);
sl@0: 	    fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK);
sl@0: #else
sl@0: 	    Tcl_SetResult(interp, "can't make pipes non-blocking",
sl@0: 		    TCL_STATIC);
sl@0: 	    return TCL_ERROR;
sl@0: #endif
sl@0: 	}
sl@0: 	pipePtr->readCount = 0;
sl@0: 	pipePtr->writeCount = 0;
sl@0: 
sl@0: 	if (strcmp(argv[3], "readable") == 0) {
sl@0: 	    Tcl_CreateFileHandler(GetFd(pipePtr->readFile), TCL_READABLE,
sl@0: 		    TestFileHandlerProc, (ClientData) pipePtr);
sl@0: 	} else if (strcmp(argv[3], "off") == 0) {
sl@0: 	    Tcl_DeleteFileHandler(GetFd(pipePtr->readFile));
sl@0: 	} else if (strcmp(argv[3], "disabled") == 0) {
sl@0: 	    Tcl_CreateFileHandler(GetFd(pipePtr->readFile), 0,
sl@0: 		    TestFileHandlerProc, (ClientData) pipePtr);
sl@0: 	} else {
sl@0: 	    Tcl_AppendResult(interp, "bad read mode \"", argv[3], "\"",
sl@0: 		    (char *) NULL);
sl@0: 	    return TCL_ERROR;
sl@0: 	}
sl@0: 	if (strcmp(argv[4], "writable") == 0) {
sl@0: 	    Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), TCL_WRITABLE,
sl@0: 		    TestFileHandlerProc, (ClientData) pipePtr);
sl@0: 	} else if (strcmp(argv[4], "off") == 0) {
sl@0: 	    Tcl_DeleteFileHandler(GetFd(pipePtr->writeFile));
sl@0: 	} else if (strcmp(argv[4], "disabled") == 0) {
sl@0: 	    Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), 0,
sl@0: 		    TestFileHandlerProc, (ClientData) pipePtr);
sl@0: 	} else {
sl@0: 	    Tcl_AppendResult(interp, "bad read mode \"", argv[4], "\"",
sl@0: 		    (char *) NULL);
sl@0: 	    return TCL_ERROR;
sl@0: 	}
sl@0:     } else if (strcmp(argv[1], "empty") == 0) {
sl@0: 	if (argc != 3) {
sl@0: 	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
sl@0:                     argv[0], " empty index\"", (char *) NULL);
sl@0: 	    return TCL_ERROR;
sl@0: 	}
sl@0: 
sl@0:         while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) {
sl@0:             /* Empty loop body. */
sl@0:         }
sl@0:     } else if (strcmp(argv[1], "fill") == 0) {
sl@0: 	if (argc != 3) {
sl@0: 	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
sl@0:                     argv[0], " fill index\"", (char *) NULL);
sl@0: 	    return TCL_ERROR;
sl@0: 	}
sl@0: 
sl@0: 	memset((VOID *) buffer, 'a', 4000);
sl@0:         while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) {
sl@0:             /* Empty loop body. */
sl@0:         }
sl@0:     } else if (strcmp(argv[1], "fillpartial") == 0) {
sl@0: 	char buf[TCL_INTEGER_SPACE];
sl@0: 	
sl@0: 	if (argc != 3) {
sl@0: 	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
sl@0:                     argv[0], " fillpartial index\"", (char *) NULL);
sl@0: 	    return TCL_ERROR;
sl@0: 	}
sl@0: 
sl@0: 	memset((VOID *) buffer, 'b', 10);
sl@0: 	TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10));
sl@0: 	Tcl_SetResult(interp, buf, TCL_VOLATILE);
sl@0:     } else if (strcmp(argv[1], "oneevent") == 0) {
sl@0: 	Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT);
sl@0:     } else if (strcmp(argv[1], "wait") == 0) {
sl@0: 	if (argc != 5) {
sl@0: 	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
sl@0:                     argv[0], " wait index readable|writable timeout\"",
sl@0:                     (char *) NULL);
sl@0: 	    return TCL_ERROR;
sl@0: 	}
sl@0: 	if (pipePtr->readFile == NULL) {
sl@0: 	    Tcl_AppendResult(interp, "pipe ", argv[2], " doesn't exist",
sl@0: 		    (char *) NULL);
sl@0: 	    return TCL_ERROR;
sl@0: 	}
sl@0: 	if (strcmp(argv[3], "readable") == 0) {
sl@0: 	    mask = TCL_READABLE;
sl@0: 	    file = pipePtr->readFile;
sl@0: 	} else {
sl@0: 	    mask = TCL_WRITABLE;
sl@0: 	    file = pipePtr->writeFile;
sl@0: 	}
sl@0: 	if (Tcl_GetInt(interp, argv[4], &timeout) != TCL_OK) {
sl@0: 	    return TCL_ERROR;
sl@0: 	}
sl@0: 	i = TclUnixWaitForFile(GetFd(file), mask, timeout);
sl@0: 	if (i & TCL_READABLE) {
sl@0: 	    Tcl_AppendElement(interp, "readable");
sl@0: 	}
sl@0: 	if (i & TCL_WRITABLE) {
sl@0: 	    Tcl_AppendElement(interp, "writable");
sl@0: 	}
sl@0:     } else if (strcmp(argv[1], "windowevent") == 0) {
sl@0: 	Tcl_DoOneEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT);
sl@0:     } else {
sl@0: 	Tcl_AppendResult(interp, "bad option \"", argv[1],
sl@0: 		"\": must be close, clear, counts, create, empty, fill, ",
sl@0: 		"fillpartial, oneevent, wait, or windowevent",
sl@0: 		(char *) NULL);
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: static void TestFileHandlerProc(clientData, mask)
sl@0:     ClientData clientData;	/* Points to a Pipe structure. */
sl@0:     int mask;			/* Indicates which events happened:
sl@0: 				 * TCL_READABLE or TCL_WRITABLE. */
sl@0: {
sl@0:     Pipe *pipePtr = (Pipe *) clientData;
sl@0: 
sl@0:     if (mask & TCL_READABLE) {
sl@0: 	pipePtr->readCount++;
sl@0:     }
sl@0:     if (mask & TCL_WRITABLE) {
sl@0: 	pipePtr->writeCount++;
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TestfilewaitCmd --
sl@0:  *
sl@0:  *	This procedure implements the "testfilewait" command. It is
sl@0:  *	used to test TclUnixWaitForFile.
sl@0:  *
sl@0:  * Results:
sl@0:  *	A standard Tcl result.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: TestfilewaitCmd(clientData, interp, argc, argv)
sl@0:     ClientData clientData;		/* Not used. */
sl@0:     Tcl_Interp *interp;			/* Current interpreter. */
sl@0:     int argc;				/* Number of arguments. */
sl@0:     CONST char **argv;			/* Argument strings. */
sl@0: {
sl@0:     int mask, result, timeout;
sl@0:     Tcl_Channel channel;
sl@0:     int fd;
sl@0:     ClientData data;
sl@0: 
sl@0:     if (argc != 4) {
sl@0: 	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
sl@0: 		" file readable|writable|both timeout\"", (char *) NULL);
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     channel = Tcl_GetChannel(interp, argv[1], NULL);
sl@0:     if (channel == NULL) {
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     if (strcmp(argv[2], "readable") == 0) {
sl@0: 	mask = TCL_READABLE;
sl@0:     } else if (strcmp(argv[2], "writable") == 0){
sl@0: 	mask = TCL_WRITABLE;
sl@0:     } else if (strcmp(argv[2], "both") == 0){
sl@0: 	mask = TCL_WRITABLE|TCL_READABLE;
sl@0:     } else {
sl@0: 	Tcl_AppendResult(interp, "bad argument \"", argv[2],
sl@0: 		"\": must be readable, writable, or both", (char *) NULL);
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     if (Tcl_GetChannelHandle(channel, 
sl@0: 	    (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE,
sl@0: 	    (ClientData*) &data) != TCL_OK) {
sl@0: 	Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC);
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     fd = (int) data;
sl@0:     if (Tcl_GetInt(interp, argv[3], &timeout) != TCL_OK) {
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     result = TclUnixWaitForFile(fd, mask, timeout);
sl@0:     if (result & TCL_READABLE) {
sl@0: 	Tcl_AppendElement(interp, "readable");
sl@0:     }
sl@0:     if (result & TCL_WRITABLE) {
sl@0: 	Tcl_AppendElement(interp, "writable");
sl@0:     }
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TestfindexecutableCmd --
sl@0:  *
sl@0:  *	This procedure implements the "testfindexecutable" command. It is
sl@0:  *	used to test Tcl_FindExecutable.
sl@0:  *
sl@0:  * Results:
sl@0:  *	A standard Tcl result.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: TestfindexecutableCmd(clientData, interp, argc, argv)
sl@0:     ClientData clientData;		/* Not used. */
sl@0:     Tcl_Interp *interp;			/* Current interpreter. */
sl@0:     int argc;				/* Number of arguments. */
sl@0:     CONST char **argv;			/* Argument strings. */
sl@0: {
sl@0:     char *oldName;
sl@0:     char *oldNativeName;
sl@0: 
sl@0:     if (argc != 2) {
sl@0: 	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
sl@0: 		" argv0\"", (char *) NULL);
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0: 
sl@0:     oldName       = tclExecutableName;
sl@0:     oldNativeName = tclNativeExecutableName;
sl@0: 
sl@0:     tclExecutableName       = NULL;
sl@0:     tclNativeExecutableName = NULL;
sl@0: 
sl@0:     Tcl_FindExecutable(argv[1]);
sl@0:     if (tclExecutableName != NULL) {
sl@0: 	Tcl_SetResult(interp, tclExecutableName, TCL_VOLATILE);
sl@0: 	ckfree(tclExecutableName);
sl@0:     }
sl@0:     if (tclNativeExecutableName != NULL) {
sl@0: 	ckfree(tclNativeExecutableName);
sl@0:     }
sl@0: 
sl@0:     tclExecutableName       = oldName;
sl@0:     tclNativeExecutableName = oldNativeName;
sl@0: 
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TestgetopenfileCmd --
sl@0:  *
sl@0:  *	This procedure implements the "testgetopenfile" command. It is
sl@0:  *	used to get a FILE * value from a registered channel.
sl@0:  *
sl@0:  * Results:
sl@0:  *	A standard Tcl result.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: TestgetopenfileCmd(clientData, interp, argc, argv)
sl@0:     ClientData clientData;		/* Not used. */
sl@0:     Tcl_Interp *interp;			/* Current interpreter. */
sl@0:     int argc;				/* Number of arguments. */
sl@0:     CONST char **argv;			/* Argument strings. */
sl@0: {
sl@0:     ClientData filePtr;
sl@0: 
sl@0:     if (argc != 3) {
sl@0:         Tcl_AppendResult(interp,
sl@0:                 "wrong # args: should be \"", argv[0],
sl@0:                 " channelName forWriting\"",
sl@0:                 (char *) NULL);
sl@0:         return TCL_ERROR;
sl@0:     }
sl@0:     if (Tcl_GetOpenFile(interp, argv[1], atoi(argv[2]), 1, &filePtr)
sl@0:             == TCL_ERROR) {
sl@0:         return TCL_ERROR;
sl@0:     }
sl@0:     if (filePtr == (ClientData) NULL) {
sl@0:         Tcl_AppendResult(interp,
sl@0:                 "Tcl_GetOpenFile succeeded but FILE * NULL!", (char *) NULL);
sl@0:         return TCL_ERROR;
sl@0:     }
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TestsetdefencdirCmd --
sl@0:  *
sl@0:  *	This procedure implements the "testsetdefenc" command. It is
sl@0:  *	used to set the value of tclDefaultEncodingDir.
sl@0:  *
sl@0:  * Results:
sl@0:  *	A standard Tcl result.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: TestsetdefencdirCmd(clientData, interp, argc, argv)
sl@0:     ClientData clientData;		/* Not used. */
sl@0:     Tcl_Interp *interp;			/* Current interpreter. */
sl@0:     int argc;				/* Number of arguments. */
sl@0:     CONST char **argv;			/* Argument strings. */
sl@0: {
sl@0:     if (argc != 2) {
sl@0:         Tcl_AppendResult(interp,
sl@0:                 "wrong # args: should be \"", argv[0],
sl@0:                 " defaultDir\"",
sl@0:                 (char *) NULL);
sl@0:         return TCL_ERROR;
sl@0:     }
sl@0: 
sl@0:     if (tclDefaultEncodingDir != NULL) {
sl@0: 	ckfree(tclDefaultEncodingDir);
sl@0: 	tclDefaultEncodingDir = NULL;
sl@0:     }
sl@0:     if (*argv[1] != '\0') {
sl@0: 	tclDefaultEncodingDir = (char *)
sl@0: 	    ckalloc((unsigned) strlen(argv[1]) + 1);
sl@0: 	strcpy(tclDefaultEncodingDir, argv[1]);
sl@0:     }
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TestgetdefencdirCmd --
sl@0:  *
sl@0:  *	This procedure implements the "testgetdefenc" command. It is
sl@0:  *	used to get the value of tclDefaultEncodingDir.
sl@0:  *
sl@0:  * Results:
sl@0:  *	A standard Tcl result.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: TestgetdefencdirCmd(clientData, interp, argc, argv)
sl@0:     ClientData clientData;		/* Not used. */
sl@0:     Tcl_Interp *interp;			/* Current interpreter. */
sl@0:     int argc;				/* Number of arguments. */
sl@0:     CONST char **argv;			/* Argument strings. */
sl@0: {
sl@0:     if (argc != 1) {
sl@0:         Tcl_AppendResult(interp,
sl@0:                 "wrong # args: should be \"", argv[0],
sl@0:                 (char *) NULL);
sl@0:         return TCL_ERROR;
sl@0:     }
sl@0: 
sl@0:     if (tclDefaultEncodingDir != NULL) {
sl@0:         Tcl_AppendResult(interp, tclDefaultEncodingDir, (char *) NULL);
sl@0:     }
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  * TestalarmCmd --
sl@0:  *
sl@0:  *	Test that EINTR is handled correctly by generating and
sl@0:  *	handling a signal.  This requires using the SA_RESTART
sl@0:  *	flag when registering the signal handler.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side Effects:
sl@0:  *	Sets up an signal and async handlers.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: TestalarmCmd(clientData, interp, argc, argv)
sl@0:     ClientData clientData;		/* Not used. */
sl@0:     Tcl_Interp *interp;			/* Current interpreter. */
sl@0:     int argc;				/* Number of arguments. */
sl@0:     CONST char **argv;			/* Argument strings. */
sl@0: {
sl@0: #ifdef SA_RESTART
sl@0:     unsigned int sec;
sl@0:     struct sigaction action;
sl@0: 
sl@0:     if (argc > 1) {
sl@0: 	Tcl_GetInt(interp, argv[1], (int *)&sec);
sl@0:     } else {
sl@0: 	sec = 1;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Setup the signal handling that automatically retries
sl@0:      * any interupted I/O system calls.
sl@0:      */
sl@0:     action.sa_handler = AlarmHandler;
sl@0:     memset((void *)&action.sa_mask, 0, sizeof(sigset_t));
sl@0:     action.sa_flags = SA_RESTART;
sl@0: 
sl@0:     if (sigaction(SIGALRM, &action, NULL) < 0) {
sl@0: 	Tcl_AppendResult(interp, "sigaction: ", Tcl_PosixError(interp), NULL);
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     (void)alarm(sec);
sl@0:     return TCL_OK;
sl@0: #else
sl@0:     Tcl_AppendResult(interp, "warning: sigaction SA_RESTART not support on this platform", NULL);
sl@0:     return TCL_ERROR;
sl@0: #endif
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * AlarmHandler --
sl@0:  *
sl@0:  *	Signal handler for the alarm command.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  * 	Calls the Tcl Async handler.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static void
sl@0: AlarmHandler()
sl@0: {
sl@0:     gotsig = "1";
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  * TestgotsigCmd --
sl@0:  *
sl@0:  * 	Verify the signal was handled after the testalarm command.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side Effects:
sl@0:  *	Resets the value of gotsig back to '0'.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: TestgotsigCmd(clientData, interp, argc, argv)
sl@0:     ClientData clientData;		/* Not used. */
sl@0:     Tcl_Interp *interp;			/* Current interpreter. */
sl@0:     int argc;				/* Number of arguments. */
sl@0:     CONST char **argv;			/* Argument strings. */
sl@0: {
sl@0:     Tcl_AppendResult(interp, gotsig, (char *) NULL);
sl@0:     gotsig = "0";
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TestchmodCmd --
sl@0:  *
sl@0:  *	Implements the "testchmod" cmd.  Used when testing "file" command.
sl@0:  *	The only attribute used by the Windows platform is the user write
sl@0:  *	flag; if this is not set, the file is made read-only.  Otehrwise, the
sl@0:  *	file is made read-write.
sl@0:  *
sl@0:  * Results:
sl@0:  *	A standard Tcl result.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Changes permissions of specified files.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: TestchmodCmd(dummy, interp, argc, argv)
sl@0:     ClientData dummy;			/* Not used. */
sl@0:     Tcl_Interp *interp;			/* Current interpreter. */
sl@0:     int argc;				/* Number of arguments. */
sl@0:     CONST char **argv;			/* Argument strings. */
sl@0: {
sl@0:     int i, mode;
sl@0:     char *rest;
sl@0: 
sl@0:     if (argc < 2) {
sl@0: 	usage:
sl@0: 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
sl@0: 		" mode file ?file ...?", NULL);
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0: 
sl@0:     mode = (int) strtol(argv[1], &rest, 8);
sl@0:     if ((rest == argv[1]) || (*rest != '\0')) {
sl@0: 	goto usage;
sl@0:     }
sl@0: 
sl@0:     for (i = 2; i < argc; i++) {
sl@0: 	Tcl_DString buffer;
sl@0: 	CONST char *translated;
sl@0: 
sl@0: 	translated = Tcl_TranslateFileName(interp, argv[i], &buffer);
sl@0: 	if (translated == NULL) {
sl@0: 	    return TCL_ERROR;
sl@0: 	}
sl@0: 	if (chmod(translated, (unsigned) mode) != 0) {
sl@0: 	    Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
sl@0: 		    NULL);
sl@0: 	    return TCL_ERROR;
sl@0: 	}
sl@0: 	Tcl_DStringFree(&buffer);
sl@0:     }
sl@0:     return TCL_OK;
sl@0: }