diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclTest.c | 1579 | ||||
| -rw-r--r-- | generic/tclTestObj.c | 251 | ||||
| -rw-r--r-- | generic/tclTestProcBodyObj.c | 91 | ||||
| -rw-r--r-- | generic/tclThreadTest.c | 566 |
4 files changed, 1201 insertions, 1286 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index 8e09f5e..d4b60a3 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -1,20 +1,20 @@ -/* +/* * tclTest.c -- * - * This file contains C command procedures for a bunch of additional - * Tcl commands that are used for testing out Tcl's C interfaces. - * These commands are not normally included in Tcl applications; - * they're only used for testing. + * This file contains C command functions for a bunch of additional Tcl + * commands that are used for testing out Tcl's C interfaces. These + * commands are not normally included in Tcl applications; they're only + * used for testing. * * Copyright (c) 1993-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 Ajuba Solutions. * Copyright (c) 2003 by Kevin B. Kenny. All rights reserved. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTest.c,v 1.97 2005/10/08 14:42:45 dgp Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.98 2005/11/02 15:59:48 dkf Exp $ */ #define TCL_TEST @@ -40,45 +40,45 @@ */ /* - * Dynamic string shared by TestdcallCmd and DelCallbackProc; used - * to collect the results of the various deletion callbacks. + * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect + * the results of the various deletion callbacks. */ static Tcl_DString delString; static Tcl_Interp *delInterp; /* - * One of the following structures exists for each asynchronous - * handler created by the "testasync" command". + * One of the following structures exists for each asynchronous handler + * created by the "testasync" command". */ typedef struct TestAsyncHandler { int id; /* Identifier for this handler. */ Tcl_AsyncHandler handler; /* Tcl's token for the handler. */ - char *command; /* Command to invoke when the - * handler is invoked. */ + char *command; /* Command to invoke when the handler + * is invoked. */ struct TestAsyncHandler *nextPtr; /* Next is list of handlers. */ } TestAsyncHandler; static TestAsyncHandler *firstHandler = NULL; /* - * The dynamic string below is used by the "testdstring" command - * to test the dynamic string facilities. + * The dynamic string below is used by the "testdstring" command to test the + * dynamic string facilities. */ static Tcl_DString dstring; /* - * The command trace below is used by the "testcmdtraceCmd" command - * to test the command tracing facilities. + * The command trace below is used by the "testcmdtraceCmd" command to test + * the command tracing facilities. */ static Tcl_Trace cmdTrace; /* - * One of the following structures exists for each command created - * by TestdelCmd: + * One of the following structures exists for each command created by + * TestdelCmd: */ typedef struct DelCmd { @@ -89,7 +89,7 @@ typedef struct DelCmd { /* * The following is used to keep track of an encoding that invokes a Tcl - * command. + * command. */ typedef struct TclEncoding { @@ -99,21 +99,22 @@ typedef struct TclEncoding { } TclEncoding; /* - * The counter below is used to determine if the TestsaveresultFree - * routine was called for a result. + * The counter below is used to determine if the TestsaveresultFree routine + * was called for a result. */ static int freeCount; /* - * Boolean flag used by the "testsetmainloop" and "testexitmainloop" - * commands. + * Boolean flag used by the "testsetmainloop" and "testexitmainloop" commands. */ + static int exitMainLoop = 0; /* * Event structure used in testing the event queue management procedures. */ + typedef struct TestEvent { Tcl_Event header; /* Header common to all events */ Tcl_Interp* interp; /* Interpreter that will handle the event */ @@ -123,8 +124,8 @@ typedef struct TestEvent { /* - * Simple detach/attach facility for testchannel cut|splice. - * Allow testing of channel transfer in core testsuite. + * Simple detach/attach facility for testchannel cut|splice. Allow testing of + * channel transfer in core testsuite. */ typedef struct TestChannel { @@ -139,328 +140,300 @@ static TestChannel* firstDetached; * Forward declarations for procedures defined later in this file: */ -int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp)); -static int AsyncHandlerProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int code)); +int Tcltest_Init(Tcl_Interp *interp); +static int AsyncHandlerProc(ClientData clientData, + Tcl_Interp *interp, int code); #ifdef TCL_THREADS -static Tcl_ThreadCreateType AsyncThreadProc _ANSI_ARGS_((ClientData)); +static Tcl_ThreadCreateType AsyncThreadProc(ClientData); #endif -static void CleanupTestSetassocdataTests _ANSI_ARGS_(( - ClientData clientData, Tcl_Interp *interp)); -static void CmdDelProc1 _ANSI_ARGS_((ClientData clientData)); -static void CmdDelProc2 _ANSI_ARGS_((ClientData clientData)); -static int CmdProc1 _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int CmdProc2 _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, CONST char **argv)); -static void CmdTraceDeleteProc _ANSI_ARGS_(( +static void CleanupTestSetassocdataTests( + ClientData clientData, Tcl_Interp *interp); +static void CmdDelProc1(ClientData clientData); +static void CmdDelProc2(ClientData clientData); +static int CmdProc1(ClientData clientData, + Tcl_Interp *interp, int argc, CONST char **argv); +static int CmdProc2(ClientData clientData, + Tcl_Interp *interp, int argc, CONST char **argv); +static void CmdTraceDeleteProc( ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *cmdProc, ClientData cmdClientData, int argc, - char **argv)); -static void CmdTraceProc _ANSI_ARGS_((ClientData clientData, + char **argv); +static void CmdTraceProc(ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *cmdProc, ClientData cmdClientData, - int argc, char **argv)); -static int CreatedCommandProc _ANSI_ARGS_(( + int argc, char **argv); +static int CreatedCommandProc( ClientData clientData, Tcl_Interp *interp, - int argc, CONST char **argv)); -static int CreatedCommandProc2 _ANSI_ARGS_(( + int argc, CONST char **argv); +static int CreatedCommandProc2( ClientData clientData, Tcl_Interp *interp, - int argc, CONST char **argv)); -static void DelCallbackProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp)); -static int DelCmdProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, CONST char **argv)); -static void DelDeleteProc _ANSI_ARGS_((ClientData clientData)); -static void EncodingFreeProc _ANSI_ARGS_((ClientData clientData)); -static int EncodingToUtfProc _ANSI_ARGS_((ClientData clientData, + int argc, CONST char **argv); +static void DelCallbackProc(ClientData clientData, + Tcl_Interp *interp); +static int DelCmdProc(ClientData clientData, + Tcl_Interp *interp, int argc, CONST char **argv); +static void DelDeleteProc(ClientData clientData); +static void EncodingFreeProc(ClientData clientData); +static int EncodingToUtfProc(ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, - int *dstCharsPtr)); -static int EncodingFromUtfProc _ANSI_ARGS_((ClientData clientData, + int *dstCharsPtr); +static int EncodingFromUtfProc(ClientData clientData, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, - int *dstCharsPtr)); -static void ExitProcEven _ANSI_ARGS_((ClientData clientData)); -static void ExitProcOdd _ANSI_ARGS_((ClientData clientData)); -static int GetTimesCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, CONST char **argv)); -static void MainLoop _ANSI_ARGS_((void)); -static int NoopCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int NoopObjCmd _ANSI_ARGS_((ClientData clientData, + int *dstCharsPtr); +static void ExitProcEven(ClientData clientData); +static void ExitProcOdd(ClientData clientData); +static int GetTimesCmd(ClientData clientData, + Tcl_Interp *interp, int argc, CONST char **argv); +static void MainLoop(void); +static int NoopCmd(ClientData clientData, + Tcl_Interp *interp, int argc, CONST char **argv); +static int NoopObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int ObjTraceProc _ANSI_ARGS_(( ClientData clientData, - Tcl_Interp* interp, - int level, - CONST char* command, - Tcl_Command commandToken, - int objc, - Tcl_Obj *CONST objv[] )); -static void ObjTraceDeleteProc _ANSI_ARGS_(( ClientData )); -static void PrintParse _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Parse *parsePtr)); -static void SpecialFree _ANSI_ARGS_((char *blockPtr)); -static int StaticInitProc _ANSI_ARGS_((Tcl_Interp *interp)); -static int TestaccessprocCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int PretendTclpAccess _ANSI_ARGS_((CONST char *path, - int mode)); -static int TestAccessProc1 _ANSI_ARGS_((CONST char *path, - int mode)); -static int TestAccessProc2 _ANSI_ARGS_((CONST char *path, - int mode)); -static int TestAccessProc3 _ANSI_ARGS_((CONST char *path, - int mode)); -static int TestasyncCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestcmdinfoCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestcmdtokenCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestcmdtraceCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestchmodCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestcreatecommandCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestdcallCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestdelCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestdelassocdataCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestdstringCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestencodingObjCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TestevalexObjCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TestevalobjvObjCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TesteventObjCmd _ANSI_ARGS_((ClientData unused, - Tcl_Interp* interp, - int argc, - Tcl_Obj *CONST objv[])); -static int TesteventProc _ANSI_ARGS_((Tcl_Event* event, - int flags)); -static int TesteventDeleteProc _ANSI_ARGS_(( - Tcl_Event* event, - ClientData clientData)); -static int TestexithandlerCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestexprlongCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestexprlongobjCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TestexprdoubleCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestexprdoubleobjCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TestexprparserObjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Obj *CONST objv[]); +static int ObjTraceProc(ClientData clientData, + Tcl_Interp* interp, int level, CONST char* command, + Tcl_Command commandToken, int objc, + Tcl_Obj *CONST objv[]); +static void ObjTraceDeleteProc(ClientData clientData); +static void PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr); +static void SpecialFree(char *blockPtr); +static int StaticInitProc(Tcl_Interp *interp); +static int TestaccessprocCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int PretendTclpAccess(CONST char *path, int mode); +static int TestAccessProc1(CONST char *path, int mode); +static int TestAccessProc2(CONST char *path, int mode); +static int TestAccessProc3(CONST char *path, int mode); +static int TestasyncCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestcmdinfoCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestcmdtokenCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestcmdtraceCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestchmodCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestcreatecommandCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestdcallCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestdelCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestdelassocdataCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestdstringCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestencodingObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +static int TestevalexObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +static int TestevalobjvObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +static int TesteventObjCmd(ClientData unused, + Tcl_Interp* interp, int argc, + Tcl_Obj *CONST objv[]); +static int TesteventProc(Tcl_Event* event, int flags); +static int TesteventDeleteProc(Tcl_Event* event, + ClientData clientData); +static int TestexithandlerCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestexprlongCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestexprlongobjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +static int TestexprdoubleCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestexprdoubleobjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +static int TestexprparserObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TestexprstringCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestfileCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); -static int TestfilelinkCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); -static int TestfeventCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestgetassocdataCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestgetintCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestgetplatformCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestgetvarfullnameCmd _ANSI_ARGS_(( + Tcl_Obj *CONST objv[]); +static int TestexprstringCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestfileCmd(ClientData dummy, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); +static int TestfilelinkCmd(ClientData dummy, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); +static int TestfeventCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestgetassocdataCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestgetintCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestgetplatformCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestgetvarfullnameCmd( ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[])); -static int TestinterpdeleteCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestlinkCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestlocaleCmd _ANSI_ARGS_((ClientData dummy, + int objc, Tcl_Obj *CONST objv[]); +static int TestinterpdeleteCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestlinkCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestlocaleCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TestMathFunc _ANSI_ARGS_((ClientData clientData, + Tcl_Obj *CONST objv[]); +static int TestMathFunc(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, - Tcl_Value *resultPtr)); -static int TestMathFunc2 _ANSI_ARGS_((ClientData clientData, + Tcl_Value *resultPtr); +static int TestMathFunc2(ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, - Tcl_Value *resultPtr)); -static int TestmainthreadCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestsetmainloopCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestexitmainloopCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static Tcl_Channel PretendTclpOpenFileChannel _ANSI_ARGS_(( + Tcl_Value *resultPtr); +static int TestmainthreadCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestsetmainloopCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestexitmainloopCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static Tcl_Channel PretendTclpOpenFileChannel( Tcl_Interp *interp, CONST char *fileName, - CONST char *modeString, int permissions)); -static Tcl_Channel TestOpenFileChannelProc1 _ANSI_ARGS_(( + CONST char *modeString, int permissions); +static Tcl_Channel TestOpenFileChannelProc1( Tcl_Interp *interp, CONST char *fileName, - CONST char *modeString, int permissions)); -static Tcl_Channel TestOpenFileChannelProc2 _ANSI_ARGS_(( + CONST char *modeString, int permissions); +static Tcl_Channel TestOpenFileChannelProc2( Tcl_Interp *interp, CONST char *fileName, - CONST char *modeString, int permissions)); -static Tcl_Channel TestOpenFileChannelProc3 _ANSI_ARGS_(( + CONST char *modeString, int permissions); +static Tcl_Channel TestOpenFileChannelProc3( Tcl_Interp *interp, CONST char *fileName, - CONST char *modeString, int permissions)); -static int TestpanicCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestparserObjCmd _ANSI_ARGS_((ClientData dummy, + CONST char *modeString, int permissions); +static int TestpanicCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestparserObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TestparsevarObjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Obj *CONST objv[]); +static int TestparsevarObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TestparsevarnameObjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Obj *CONST objv[]); +static int TestparsevarnameObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TestregexpObjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Obj *CONST objv[]); +static int TestregexpObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TestreturnObjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Obj *CONST objv[]); +static int TestreturnObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static void TestregexpXflags _ANSI_ARGS_((char *string, - int length, int *cflagsPtr, int *eflagsPtr)); -static int TestsaveresultCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Obj *CONST objv[]); +static void TestregexpXflags(char *string, + int length, int *cflagsPtr, int *eflagsPtr); +static int TestsaveresultCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static void TestsaveresultFree _ANSI_ARGS_((char *blockPtr)); -static int TestsetassocdataCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestsetCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestseterrorcodeCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestsetobjerrorcodeCmd _ANSI_ARGS_(( + Tcl_Obj *CONST objv[]); +static void TestsaveresultFree(char *blockPtr); +static int TestsetassocdataCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestsetCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestseterrorcodeCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestsetobjerrorcodeCmd( ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[])); -static int TestopenfilechannelprocCmd _ANSI_ARGS_(( + int objc, Tcl_Obj *CONST objv[]); +static int TestopenfilechannelprocCmd( ClientData dummy, Tcl_Interp *interp, int argc, - CONST char **argv)); -static int TestsetplatformCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TeststaticpkgCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int PretendTclpStat _ANSI_ARGS_((CONST char *path, - struct stat *buf)); -static int TestStatProc1 _ANSI_ARGS_((CONST char *path, - struct stat *buf)); -static int TestStatProc2 _ANSI_ARGS_((CONST char *path, - struct stat *buf)); -static int TestStatProc3 _ANSI_ARGS_((CONST char *path, - struct stat *buf)); -static int TeststatprocCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TesttranslatefilenameCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestupvarCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestWrongNumArgsObjCmd _ANSI_ARGS_(( + CONST char **argv); +static int TestsetplatformCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TeststaticpkgCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int PretendTclpStat(CONST char *path, + struct stat *buf); +static int TestStatProc1(CONST char *path, + struct stat *buf); +static int TestStatProc2(CONST char *path, + struct stat *buf); +static int TestStatProc3(CONST char *path, + struct stat *buf); +static int TeststatprocCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TesttranslatefilenameCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestupvarCmd(ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestWrongNumArgsObjCmd( ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[])); -static int TestGetIndexFromObjStructObjCmd _ANSI_ARGS_(( + int objc, Tcl_Obj *CONST objv[]); +static int TestGetIndexFromObjStructObjCmd( ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[])); -static int TestChannelCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, CONST char **argv)); -static int TestChannelEventCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, CONST char **argv)); -/* Filesystem testing */ - -static int TestFilesystemObjCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TestSimpleFilesystemObjCmd _ANSI_ARGS_(( - ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); - -static void TestReport _ANSI_ARGS_ ((CONST char* cmd, Tcl_Obj* arg1, - Tcl_Obj* arg2)); - -static Tcl_Obj* TestReportGetNativePath _ANSI_ARGS_ (( - Tcl_Obj* pathPtr)); - -static int TestReportStat _ANSI_ARGS_ ((Tcl_Obj *path, - Tcl_StatBuf *buf)); -static int TestReportAccess _ANSI_ARGS_ ((Tcl_Obj *path, - int mode)); -static Tcl_Channel TestReportOpenFileChannel _ANSI_ARGS_ (( - Tcl_Interp *interp, Tcl_Obj *fileName, - int mode, int permissions)); -static int TestReportMatchInDirectory _ANSI_ARGS_ (( - Tcl_Interp *interp, Tcl_Obj *resultPtr, - Tcl_Obj *dirPtr, CONST char *pattern, - Tcl_GlobTypeData *types)); -static int TestReportChdir _ANSI_ARGS_ ((Tcl_Obj *dirName)); -static int TestReportLstat _ANSI_ARGS_ ((Tcl_Obj *path, - Tcl_StatBuf *buf)); -static int TestReportCopyFile _ANSI_ARGS_ ((Tcl_Obj *src, - Tcl_Obj *dst)); -static int TestReportDeleteFile _ANSI_ARGS_ ((Tcl_Obj *path)); -static int TestReportRenameFile _ANSI_ARGS_ ((Tcl_Obj *src, - Tcl_Obj *dst)); -static int TestReportCreateDirectory _ANSI_ARGS_ ((Tcl_Obj *path)); -static int TestReportCopyDirectory _ANSI_ARGS_ ((Tcl_Obj *src, - Tcl_Obj *dst, Tcl_Obj **errorPtr)); -static int TestReportRemoveDirectory _ANSI_ARGS_ ((Tcl_Obj *path, - int recursive, Tcl_Obj **errorPtr)); -static int TestReportLoadFile _ANSI_ARGS_ ((Tcl_Interp *interp, - Tcl_Obj *fileName, - Tcl_LoadHandle *handlePtr, - Tcl_FSUnloadFileProc **unloadProcPtr)); -static Tcl_Obj * TestReportLink _ANSI_ARGS_ ((Tcl_Obj *path, - Tcl_Obj *to, int linkType)); -static CONST char** TestReportFileAttrStrings _ANSI_ARGS_ (( - Tcl_Obj *fileName, Tcl_Obj **objPtrRef)); -static int TestReportFileAttrsGet _ANSI_ARGS_ ((Tcl_Interp *interp, - int index, Tcl_Obj *fileName, Tcl_Obj **objPtrRef)); -static int TestReportFileAttrsSet _ANSI_ARGS_ ((Tcl_Interp *interp, - int index, Tcl_Obj *fileName, Tcl_Obj *objPtr)); -static int TestReportUtime _ANSI_ARGS_ ((Tcl_Obj *fileName, - struct utimbuf *tval)); -static int TestReportNormalizePath _ANSI_ARGS_ (( - Tcl_Interp *interp, Tcl_Obj *pathPtr, - int nextCheckpoint)); -static int TestReportInFilesystem _ANSI_ARGS_ ((Tcl_Obj *pathPtr, ClientData *clientDataPtr)); -static void TestReportFreeInternalRep _ANSI_ARGS_ ((ClientData clientData)); -static ClientData TestReportDupInternalRep _ANSI_ARGS_ ((ClientData clientData)); - -static int SimpleStat _ANSI_ARGS_ ((Tcl_Obj *path, - Tcl_StatBuf *buf)); -static int SimpleAccess _ANSI_ARGS_ ((Tcl_Obj *path, - int mode)); -static Tcl_Channel SimpleOpenFileChannel _ANSI_ARGS_ (( + int objc, Tcl_Obj *CONST objv[]); +static int TestChannelCmd(ClientData clientData, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestChannelEventCmd(ClientData clientData, + Tcl_Interp *interp, int argc, CONST char **argv); +static int TestFilesystemObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +static int TestSimpleFilesystemObjCmd( + ClientData dummy, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +static void TestReport(CONST char* cmd, Tcl_Obj* arg1, + Tcl_Obj* arg2); +static Tcl_Obj* TestReportGetNativePath(Tcl_Obj* pathPtr); +static int TestReportStat(Tcl_Obj *path, Tcl_StatBuf *buf); +static int TestReportAccess(Tcl_Obj *path, int mode); +static Tcl_Channel TestReportOpenFileChannel( Tcl_Interp *interp, Tcl_Obj *fileName, - int mode, int permissions)); -static Tcl_Obj* SimpleListVolumes _ANSI_ARGS_ ((void)); -static int SimplePathInFilesystem _ANSI_ARGS_ (( - Tcl_Obj *pathPtr, ClientData *clientDataPtr)); -static Tcl_Obj* SimpleRedirect _ANSI_ARGS_ ((Tcl_Obj *pathPtr)); -static int SimpleMatchInDirectory _ANSI_ARGS_ (( + int mode, int permissions); +static int TestReportMatchInDirectory(Tcl_Interp *interp, + Tcl_Obj *resultPtr, Tcl_Obj *dirPtr, + CONST char *pattern, Tcl_GlobTypeData *types); +static int TestReportChdir(Tcl_Obj *dirName); +static int TestReportLstat(Tcl_Obj *path, Tcl_StatBuf *buf); +static int TestReportCopyFile(Tcl_Obj *src, Tcl_Obj *dst); +static int TestReportDeleteFile(Tcl_Obj *path); +static int TestReportRenameFile(Tcl_Obj *src, Tcl_Obj *dst); +static int TestReportCreateDirectory(Tcl_Obj *path); +static int TestReportCopyDirectory(Tcl_Obj *src, + Tcl_Obj *dst, Tcl_Obj **errorPtr); +static int TestReportRemoveDirectory(Tcl_Obj *path, + int recursive, Tcl_Obj **errorPtr); +static int TestReportLoadFile(Tcl_Interp *interp, + Tcl_Obj *fileName, Tcl_LoadHandle *handlePtr, + Tcl_FSUnloadFileProc **unloadProcPtr); +static Tcl_Obj * TestReportLink(Tcl_Obj *path, + Tcl_Obj *to, int linkType); +static CONST char** TestReportFileAttrStrings( + Tcl_Obj *fileName, Tcl_Obj **objPtrRef); +static int TestReportFileAttrsGet(Tcl_Interp *interp, + int index, Tcl_Obj *fileName, Tcl_Obj **objPtrRef); +static int TestReportFileAttrsSet(Tcl_Interp *interp, + int index, Tcl_Obj *fileName, Tcl_Obj *objPtr); +static int TestReportUtime(Tcl_Obj *fileName, + struct utimbuf *tval); +static int TestReportNormalizePath(Tcl_Interp *interp, + Tcl_Obj *pathPtr, int nextCheckpoint); +static int TestReportInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr); +static void TestReportFreeInternalRep(ClientData clientData); +static ClientData TestReportDupInternalRep(ClientData clientData); + +static int SimpleStat(Tcl_Obj *path, Tcl_StatBuf *buf); +static int SimpleAccess(Tcl_Obj *path, int mode); +static Tcl_Channel SimpleOpenFileChannel(Tcl_Interp *interp, + Tcl_Obj *fileName, int mode, int permissions); +static Tcl_Obj* SimpleListVolumes(void); +static int SimplePathInFilesystem( + Tcl_Obj *pathPtr, ClientData *clientDataPtr); +static Tcl_Obj* SimpleRedirect(Tcl_Obj *pathPtr); +static int SimpleMatchInDirectory( Tcl_Interp *interp, Tcl_Obj *resultPtr, Tcl_Obj *dirPtr, CONST char *pattern, - Tcl_GlobTypeData *types)); -static int TestNumUtfCharsCmd _ANSI_ARGS_((ClientData clientData, + Tcl_GlobTypeData *types); +static int TestNumUtfCharsCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TestHashSystemHashCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Obj *CONST objv[]); +static int TestHashSystemHashCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); + Tcl_Obj *CONST objv[]); static Tcl_Filesystem testReportingFilesystem = { "reporting", @@ -485,11 +458,11 @@ static Tcl_Filesystem testReportingFilesystem = { &TestReportFileAttrsGet, &TestReportFileAttrsSet, &TestReportCreateDirectory, - &TestReportRemoveDirectory, + &TestReportRemoveDirectory, &TestReportDeleteFile, &TestReportCopyFile, &TestReportRenameFile, - &TestReportCopyDirectory, + &TestReportCopyDirectory, &TestReportLstat, &TestReportLoadFile, NULL /* cwd */, @@ -526,14 +499,14 @@ static Tcl_Filesystem simpleFilesystem = { NULL, NULL, NULL, - NULL, + NULL, NULL, /* No copy file - fallback will occur at Tcl level */ NULL, /* No rename file - fallback will occur at Tcl level */ NULL, /* No copy directory - fallback will occur at Tcl level */ - NULL, + NULL, /* Use stat for lstat */ NULL, /* No load - fallback on core implementation */ @@ -546,25 +519,25 @@ static Tcl_Filesystem simpleFilesystem = { /* * External (platform specific) initialization routine, these declarations - * explicitly don't use EXTERN since this code does not get compiled - * into the library: + * explicitly don't use EXTERN since this code does not get compiled into the + * library: */ -extern int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp)); -extern int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp)); +extern int TclplatformtestInit(Tcl_Interp *interp); +extern int TclThread_Init(Tcl_Interp *interp); /* *---------------------------------------------------------------------- * * Tcltest_Init -- * - * This procedure performs application-specific initialization. - * Most applications, especially those that incorporate additional - * packages, will have their own version of this procedure. + * This procedure performs application-specific initialization. Most + * applications, especially those that incorporate additional packages, + * will have their own version of this procedure. * * Results: - * Returns a standard Tcl completion code, and leaves an error - * message in the interp's result if an error occurs. + * Returns a standard Tcl completion code, and leaves an error message in + * the interp's result if an error occurs. * * Side effects: * Depends on the startup script. @@ -573,8 +546,8 @@ extern int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp)); */ int -Tcltest_Init(interp) - Tcl_Interp *interp; /* Interpreter for application. */ +Tcltest_Init( + Tcl_Interp *interp) /* Interpreter for application. */ { Tcl_ValueType t3ArgTypes[2]; @@ -583,7 +556,7 @@ Tcltest_Init(interp) int objc, index; static CONST char *specialOptions[] = { "-appinitprocerror", "-appinitprocdeleteinterp", - "-appinitprocclosestderr", "-appinitprocsetrcfile", (char *) NULL + "-appinitprocclosestderr", "-appinitprocsetrcfile", NULL }; if (Tcl_PkgProvide(interp, "Tcltest", TCL_VERSION) == TCL_ERROR) { @@ -594,146 +567,128 @@ Tcltest_Init(interp) * Create additional commands and math functions for testing Tcl. */ - Tcl_CreateCommand(interp, "gettimes", GetTimesCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateCommand(interp, "noop", NoopCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateCommand(interp, "gettimes", GetTimesCmd, (ClientData) 0, NULL); + Tcl_CreateCommand(interp, "noop", NoopCmd, (ClientData) 0, NULL); + Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); + Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, + (ClientData) 0, NULL); + Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd, + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct", - TestGetIndexFromObjStructObjCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); + TestGetIndexFromObjStructObjCmd, (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testaccessproc", TestaccessprocCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateCommand(interp, "testasync", TestasyncCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); + NULL); + Tcl_CreateCommand(interp, "testasync", TestasyncCmd, (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testchannel", TestChannelCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); + NULL); Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); + NULL); Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateCommand(interp, "testdel", TestdelCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); + Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, (ClientData) 0, NULL); + Tcl_CreateCommand(interp, "testdel", TestdelCmd, (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_DStringInit(&dstring); Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); + NULL); Tcl_CreateObjCommand(interp, "testencoding", TestencodingObjCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); + NULL); Tcl_CreateObjCommand(interp, "testevalex", TestevalexObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testevalobjv", TestevalobjvObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand( interp, "testevent", TesteventObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc*) NULL ); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testexithandler", TestexithandlerCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testexprlong", TestexprlongCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testexprlongobj", TestexprlongobjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testexprdouble", TestexprdoubleCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testexprdoubleobj", TestexprdoubleobjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testexprparser", TestexprparserObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testexprstring", TestexprstringCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "testfilelink", TestfilelinkCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + NULL); + Tcl_CreateObjCommand(interp, "testfilelink", TestfilelinkCmd, + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testfile", TestfileCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testhashsystemhash", - TestHashSystemHashCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); + TestHashSystemHashCmd, (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testgetint", TestgetintCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testgetvarfullname", - TestgetvarfullnameCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); + TestgetvarfullnameCmd, (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateCommand(interp, "testlink", TestlinkCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); + Tcl_CreateCommand(interp, "testlink", TestlinkCmd, (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); + NULL); Tcl_CreateCommand(interp, "testopenfilechannelproc", - TestopenfilechannelprocCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); + TestopenfilechannelprocCmd, (ClientData) 0, NULL); + Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testseterr", TestsetCmd, - (ClientData) TCL_LEAVE_ERR_MSG, (Tcl_CmdDeleteProc *) NULL); + (ClientData) TCL_LEAVE_ERR_MSG, NULL); Tcl_CreateCommand(interp, "testseterrorcode", TestseterrorcodeCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "testsetobjerrorcode", - TestsetobjerrorcodeCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); + Tcl_CreateObjCommand(interp, "testsetobjerrorcode", + TestsetobjerrorcodeCmd, (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testnumutfchars", - TestNumUtfCharsCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); + TestNumUtfCharsCmd, (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testtranslatefilename", - TesttranslatefilenameCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateMathFunc(interp, "T1", 0, (Tcl_ValueType *) NULL, TestMathFunc, - (ClientData) 123); - Tcl_CreateMathFunc(interp, "T2", 0, (Tcl_ValueType *) NULL, TestMathFunc, - (ClientData) 345); + TesttranslatefilenameCmd, (ClientData) 0, NULL); + Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, (ClientData) 0, NULL); + Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123); + Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345); Tcl_CreateCommand(interp, "teststatproc", TeststatprocCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); + NULL); Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, (ClientData) 0, - (Tcl_CmdDeleteProc *) NULL); + NULL); Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd, - (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + (ClientData) NULL, NULL); Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd, - (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + (ClientData) NULL, NULL); t3ArgTypes[0] = TCL_EITHER; t3ArgTypes[1] = TCL_EITHER; Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2, @@ -757,34 +712,31 @@ Tcltest_Init(interp) if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL, TCL_EXACT, &index) == TCL_OK)) { switch (index) { - case 0: { - return TCL_ERROR; - } - case 1: { - Tcl_DeleteInterp(interp); - return TCL_ERROR; - } - case 2: { - int mode; - Tcl_UnregisterChannel(interp, - Tcl_GetChannel(interp, "stderr", &mode)); - return TCL_ERROR; - } - case 3: { - if (objc-1) { - Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL, - objv[1], TCL_GLOBAL_ONLY); - } - return TCL_ERROR; - } + case 0: + return TCL_ERROR; + case 1: + Tcl_DeleteInterp(interp); + return TCL_ERROR; + case 2: { + int mode; + Tcl_UnregisterChannel(interp, + Tcl_GetChannel(interp, "stderr", &mode)); + return TCL_ERROR; + } + case 3: + if (objc-1) { + Tcl_SetVar2Ex(interp, "tcl_rcFileName", NULL, objv[1], + TCL_GLOBAL_ONLY); + } + return TCL_ERROR; } } } - + /* * And finally add any platform specific test commands. */ - + return TclplatformtestInit(interp); } @@ -910,14 +862,12 @@ TestasyncCmd(dummy, interp, argc, argv) } } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be create, delete, int, mark, or marklater", - (char *) NULL); + "\": must be create, delete, int, mark, or marklater", NULL); return TCL_ERROR; #else /* !TCL_THREADS */ } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be create, delete, int, or mark", - (char *) NULL); + "\": must be create, delete, int, or mark", NULL); return TCL_ERROR; #endif } @@ -945,9 +895,8 @@ AsyncHandlerProc(clientData, interp, code) code = Tcl_Eval(interp, cmd); } else { /* - * this should not happen, but by definition of how async - * handlers are invoked, it's possible. Better error - * checking is needed here. + * this should not happen, but by definition of how async handlers are + * invoked, it's possible. Better error checking is needed here. */ } ckfree((char *)cmd); @@ -989,9 +938,9 @@ AsyncThreadProc(clientData) * * TestcmdinfoCmd -- * - * This procedure implements the "testcmdinfo" command. It is used - * to test Tcl_GetCommandInfo, Tcl_SetCommandInfo, and command creation - * and deletion. + * This procedure implements the "testcmdinfo" command. It is used to + * test Tcl_GetCommandInfo, Tcl_SetCommandInfo, and command creation and + * deletion. * * Results: * A standard Tcl result. @@ -1014,7 +963,7 @@ TestcmdinfoCmd(dummy, interp, argc, argv) if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option cmdName\"", (char *) NULL); + " option cmdName\"", NULL); return TCL_ERROR; } if (strcmp(argv[1], "create") == 0) { @@ -1031,28 +980,27 @@ TestcmdinfoCmd(dummy, interp, argc, argv) } if (info.proc == CmdProc1) { Tcl_AppendResult(interp, "CmdProc1", " ", - (char *) info.clientData, (char *) NULL); + (char *) info.clientData, NULL); } else if (info.proc == CmdProc2) { Tcl_AppendResult(interp, "CmdProc2", " ", - (char *) info.clientData, (char *) NULL); + (char *) info.clientData, NULL); } else { - Tcl_AppendResult(interp, "unknown", (char *) NULL); + Tcl_AppendResult(interp, "unknown", NULL); } if (info.deleteProc == CmdDelProc1) { Tcl_AppendResult(interp, " CmdDelProc1", " ", - (char *) info.deleteData, (char *) NULL); + (char *) info.deleteData, NULL); } else if (info.deleteProc == CmdDelProc2) { Tcl_AppendResult(interp, " CmdDelProc2", " ", - (char *) info.deleteData, (char *) NULL); + (char *) info.deleteData, NULL); } else { - Tcl_AppendResult(interp, " unknown", (char *) NULL); + Tcl_AppendResult(interp, " unknown", NULL); } - Tcl_AppendResult(interp, " ", info.namespacePtr->fullName, - (char *) NULL); + Tcl_AppendResult(interp, " ", info.namespacePtr->fullName, NULL); if (info.isNativeObjectProc) { - Tcl_AppendResult(interp, " nativeObjectProc", (char *) NULL); + Tcl_AppendResult(interp, " nativeObjectProc", NULL); } else { - Tcl_AppendResult(interp, " stringProc", (char *) NULL); + Tcl_AppendResult(interp, " stringProc", NULL); } } else if (strcmp(argv[1], "modify") == 0) { info.proc = CmdProc2; @@ -1068,8 +1016,7 @@ TestcmdinfoCmd(dummy, interp, argc, argv) } } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be create, delete, get, or modify", - (char *) NULL); + "\": must be create, delete, get, or modify", NULL); return TCL_ERROR; } return TCL_OK; @@ -1083,8 +1030,7 @@ CmdProc1(clientData, interp, argc, argv) int argc; /* Number of arguments. */ CONST char **argv; /* Argument strings. */ { - Tcl_AppendResult(interp, "CmdProc1 ", (char *) clientData, - (char *) NULL); + Tcl_AppendResult(interp, "CmdProc1 ", (char *) clientData, NULL); return TCL_OK; } @@ -1096,8 +1042,7 @@ CmdProc2(clientData, interp, argc, argv) int argc; /* Number of arguments. */ CONST char **argv; /* Argument strings. */ { - Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData, - (char *) NULL); + Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData, NULL); return TCL_OK; } @@ -1124,9 +1069,8 @@ CmdDelProc2(clientData) * * TestcmdtokenCmd -- * - * This procedure implements the "testcmdtoken" command. It is used - * to test Tcl_Command tokens and procedures such as - * Tcl_GetCommandFullName. + * This procedure implements the "testcmdtoken" command. It is used to + * test Tcl_Command tokens and procedures such as Tcl_GetCommandFullName. * * Results: * A standard Tcl result. @@ -1151,20 +1095,20 @@ TestcmdtokenCmd(dummy, interp, argc, argv) if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option arg\"", (char *) NULL); + " option arg\"", NULL); return TCL_ERROR; } if (strcmp(argv[1], "create") == 0) { token = Tcl_CreateCommand(interp, argv[2], CmdProc1, - (ClientData) "original", (Tcl_CmdDeleteProc *) NULL); - sprintf(buf, "%p", (VOID *)token); + (ClientData) "original", NULL); + sprintf(buf, "%p", (void *)token); Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if (strcmp(argv[1], "name") == 0) { Tcl_Obj *objPtr; if (sscanf(argv[2], "%p", &l) != 1) { Tcl_AppendResult(interp, "bad command token \"", argv[2], - "\"", (char *) NULL); + "\"", NULL); return TCL_ERROR; } @@ -1177,7 +1121,7 @@ TestcmdtokenCmd(dummy, interp, argc, argv) Tcl_DecrRefCount(objPtr); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be create or name", (char *) NULL); + "\": must be create or name", NULL); return TCL_ERROR; } return TCL_OK; @@ -1214,7 +1158,7 @@ TestcmdtraceCmd(dummy, interp, argc, argv) if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option script\"", (char *) NULL); + " option script\"", NULL); return TCL_ERROR; } @@ -1232,11 +1176,11 @@ TestcmdtraceCmd(dummy, interp, argc, argv) } else if (strcmp(argv[1], "deletetest") == 0) { /* * Create a command trace then eval a script to check whether it is - * called. Note that this trace procedure removes itself as a - * further check of the robustness of the trace proc calling code in + * called. Note that this trace procedure removes itself as a further + * check of the robustness of the trace proc calling code in * TclExecuteByteCode. */ - + cmdTrace = Tcl_CreateTrace(interp, 50000, (Tcl_CmdTraceProc *) CmdTraceDeleteProc, (ClientData) NULL); Tcl_Eval(interp, argv[2]); @@ -1258,11 +1202,9 @@ TestcmdtraceCmd(dummy, interp, argc, argv) */ static int deleteCalled; deleteCalled = 0; - cmdTrace = Tcl_CreateObjTrace( interp, 50000, - TCL_ALLOW_INLINE_COMPILATION, - ObjTraceProc, - (ClientData) &deleteCalled, - ObjTraceDeleteProc ); + cmdTrace = Tcl_CreateObjTrace(interp, 50000, + TCL_ALLOW_INLINE_COMPILATION, ObjTraceProc, + (ClientData) &deleteCalled, ObjTraceDeleteProc); result = Tcl_Eval( interp, argv[ 2 ] ); Tcl_DeleteTrace( interp, cmdTrace ); if ( !deleteCalled ) { @@ -1271,11 +1213,10 @@ TestcmdtraceCmd(dummy, interp, argc, argv) } else { return result; } - + } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be tracetest, deletetest or resulttest", - (char *) NULL); + "\": must be tracetest, deletetest or resulttest", NULL); return TCL_ERROR; } return TCL_OK; @@ -1324,11 +1265,11 @@ CmdTraceDeleteProc(clientData, interp, level, command, cmdProc, char **argv; /* Argument strings. */ { /* - * Remove ourselves to test whether calling Tcl_DeleteTrace within - * a trace callback causes the for loop in TclExecuteByteCode that - * calls traces to reference freed memory. + * Remove ourselves to test whether calling Tcl_DeleteTrace within a trace + * callback causes the for loop in TclExecuteByteCode that calls traces to + * reference freed memory. */ - + Tcl_DeleteTrace(interp, cmdTrace); } @@ -1372,11 +1313,11 @@ ObjTraceDeleteProc( clientData ) * * TestcreatecommandCmd -- * - * This procedure implements the "testcreatecommand" command. It is - * used to test that the Tcl_CreateCommand creates a new command in - * the namespace specified as part of its name, if any. It also - * checks that the namespace code ignore single ":"s in the middle - * or end of a command name. + * This procedure implements the "testcreatecommand" command. It is used + * to test that the Tcl_CreateCommand creates a new command in the + * namespace specified as part of its name, if any. It also checks that + * the namespace code ignore single ":"s in the middle or end of a + * command name. * * Results: * A standard Tcl result. @@ -1397,25 +1338,22 @@ TestcreatecommandCmd(dummy, interp, argc, argv) { if (argc != 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option\"", (char *) NULL); + " option\"", NULL); return TCL_ERROR; } if (strcmp(argv[1], "create") == 0) { Tcl_CreateCommand(interp, "test_ns_basic::createdcommand", - CreatedCommandProc, (ClientData) NULL, - (Tcl_CmdDeleteProc *) NULL); + CreatedCommandProc, (ClientData) NULL, NULL); } else if (strcmp(argv[1], "delete") == 0) { Tcl_DeleteCommand(interp, "test_ns_basic::createdcommand"); } else if (strcmp(argv[1], "create2") == 0) { Tcl_CreateCommand(interp, "value:at:", - CreatedCommandProc2, (ClientData) NULL, - (Tcl_CmdDeleteProc *) NULL); + CreatedCommandProc2, (ClientData) NULL, NULL); } else if (strcmp(argv[1], "delete2") == 0) { Tcl_DeleteCommand(interp, "value:at:"); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be create, delete, create2, or delete2", - (char *) NULL); + "\": must be create, delete, create2, or delete2", NULL); return TCL_ERROR; } return TCL_OK; @@ -1435,11 +1373,11 @@ CreatedCommandProc(clientData, interp, argc, argv) &info); if (!found) { Tcl_AppendResult(interp, "CreatedCommandProc could not get command info for test_ns_basic::createdcommand", - (char *) NULL); + NULL); return TCL_ERROR; } Tcl_AppendResult(interp, "CreatedCommandProc in ", - info.namespacePtr->fullName, (char *) NULL); + info.namespacePtr->fullName, NULL); return TCL_OK; } @@ -1456,11 +1394,11 @@ CreatedCommandProc2(clientData, interp, argc, argv) found = Tcl_GetCommandInfo(interp, "value:at:", &info); if (!found) { Tcl_AppendResult(interp, "CreatedCommandProc2 could not get command info for test_ns_basic::createdcommand", - (char *) NULL); + NULL); return TCL_ERROR; } Tcl_AppendResult(interp, "CreatedCommandProc2 in ", - info.namespacePtr->fullName, (char *) NULL); + info.namespacePtr->fullName, NULL); return TCL_OK; } @@ -1587,7 +1525,7 @@ DelCmdProc(clientData, interp, argc, argv) { DelCmd *dPtr = (DelCmd *) clientData; - Tcl_AppendResult(interp, dPtr->deleteCmd, (char *) NULL); + Tcl_AppendResult(interp, dPtr->deleteCmd, NULL); ckfree(dPtr->deleteCmd); ckfree((char *) dPtr); return TCL_OK; @@ -1632,7 +1570,7 @@ TestdelassocdataCmd(clientData, interp, argc, argv) { if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " data_key\"", (char *) NULL); + " data_key\"", NULL); return TCL_ERROR; } Tcl_DeleteAssocData(interp, argv[1]); @@ -1718,13 +1656,13 @@ TestdstringCmd(dummy, interp, argc, argv) } else { Tcl_AppendResult(interp, "bad gresult option \"", argv[2], "\": must be staticsmall, staticlarge, free, or special", - (char *) NULL); + NULL); return TCL_ERROR; } Tcl_DStringGetResult(interp, &dstring); } else if (strcmp(argv[1], "length") == 0) { char buf[TCL_INTEGER_SPACE]; - + if (argc != 2) { goto wrongNumArgs; } @@ -1751,7 +1689,7 @@ TestdstringCmd(dummy, interp, argc, argv) } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be append, element, end, free, get, length, ", - "result, trunc, or start", (char *) NULL); + "result, trunc, or start", NULL); return TCL_ERROR; } return TCL_OK; @@ -1804,7 +1742,7 @@ TestencodingObjCmd(dummy, interp, objc, objv) enum options { ENC_CREATE, ENC_DELETE, ENC_PATH }; - + if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, &index) != TCL_OK) { return TCL_ERROR; @@ -1860,7 +1798,7 @@ TestencodingObjCmd(dummy, interp, objc, objv) } return TCL_OK; } -static int +static int EncodingToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr) ClientData clientData; /* TclEncoding structure. */ @@ -1892,7 +1830,7 @@ EncodingToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen, *dstCharsPtr = len; return TCL_OK; } -static int +static int EncodingFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr) ClientData clientData; /* TclEncoding structure. */ @@ -1968,7 +1906,7 @@ TestevalexObjCmd(dummy, interp, objc, objv) char *global = Tcl_GetStringFromObj(objv[2], &length); if (strcmp(global, "global") != 0) { Tcl_AppendResult(interp, "bad value \"", global, - "\": must be global", (char *) NULL); + "\": must be global", NULL); return TCL_ERROR; } flags = TCL_EVAL_GLOBAL; @@ -1978,7 +1916,7 @@ TestevalexObjCmd(dummy, interp, objc, objv) } script = Tcl_GetStringFromObj(objv[1], &length); - return Tcl_EvalEx(interp, script, length, flags); + return Tcl_EvalEx(interp, script, length, flags); } /* @@ -2053,7 +1991,7 @@ TesteventObjCmd( ClientData unused, /* Not used */ int objc, /* Parameter count */ Tcl_Obj *CONST objv[] ) /* Parameter vector */ { - + static CONST char* subcommands[] = { /* Possible subcommands */ "queue", "delete", @@ -2067,7 +2005,7 @@ TesteventObjCmd( ClientData unused, /* Not used */ NULL }; int posIndex; /* Index of the chosen position */ - static CONST Tcl_QueuePosition posNum[] = { + static CONST Tcl_QueuePosition posNum[] = { /* Interpretation of the chosen position */ TCL_QUEUE_HEAD, TCL_QUEUE_TAIL, @@ -2125,16 +2063,15 @@ TesteventObjCmd( ClientData unused, /* Not used */ * * Delivers a test event to the Tcl interpreter as part of event * queue testing. - * + * * Results: * Returns 1 if the event has been serviced, 0 otherwise. * * Side effects: - * Evaluates the event's callback script, so has whatever - * side effects the callback has. The return value of the - * callback script becomes the return value of this function. - * If the callback script reports an error, it is reported as - * a background error. + * Evaluates the event's callback script, so has whatever side effects + * the callback has. The return value of the callback script becomes the + * return value of this function. If the callback script reports an + * error, it is reported as a background error. * *---------------------------------------------------------------------- */ @@ -2146,20 +2083,19 @@ TesteventProc( Tcl_Event* event, /* Event to deliver */ TestEvent * ev = (TestEvent *) event; Tcl_Interp* interp = ev->interp; Tcl_Obj* command = ev->command; - int result = Tcl_EvalObjEx( interp, command, - TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT ); + int result = Tcl_EvalObjEx(interp, command, + TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); int retval; if ( result != TCL_OK ) { Tcl_AddErrorInfo( interp, - " (command bound to \"testevent\" callback)" ); + " (command bound to \"testevent\" callback)" ); Tcl_BackgroundError( interp ); return 1; /* Avoid looping on errors */ } - if ( Tcl_GetBooleanFromObj( interp, - Tcl_GetObjResult( interp ), - &retval ) != TCL_OK ) { - Tcl_AddErrorInfo( interp, - " (return value from \"testevent\" callback)" ); + if (Tcl_GetBooleanFromObj(interp, Tcl_GetObjResult(interp), + &retval) != TCL_OK) { + Tcl_AddErrorInfo( interp, + " (return value from \"testevent\" callback)" ); Tcl_BackgroundError( interp ); return 1; } @@ -2167,7 +2103,7 @@ TesteventProc( Tcl_Event* event, /* Event to deliver */ Tcl_DecrRefCount( ev->tag ); Tcl_DecrRefCount( ev->command ); } - + return retval; } @@ -2243,7 +2179,7 @@ TestexithandlerCmd(clientData, interp, argc, argv) if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " create|delete value\"", (char *) NULL); + " create|delete value\"", NULL); return TCL_ERROR; } if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) { @@ -2257,7 +2193,7 @@ TestexithandlerCmd(clientData, interp, argc, argv) (ClientData) value); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be create or delete", (char *) NULL); + "\": must be create or delete", NULL); return TCL_ERROR; } return TCL_OK; @@ -2313,7 +2249,7 @@ TestexprlongCmd(clientData, interp, argc, argv) if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " expression\"", (char *) NULL); + " expression\"", NULL); return TCL_ERROR; } Tcl_SetResult(interp, "This is a result", TCL_STATIC); @@ -2398,7 +2334,7 @@ TestexprdoubleCmd(clientData, interp, argc, argv) if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " expression\"", (char *) NULL); + " expression\"", NULL); return TCL_ERROR; } Tcl_SetResult(interp, "This is a result", TCL_STATIC); @@ -2480,7 +2416,7 @@ TestexprstringCmd(clientData, interp, argc, argv) { if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " expression\"", (char *) NULL); + " expression\"", NULL); return TCL_ERROR; } return Tcl_ExprString(interp, argv[1]); @@ -2491,9 +2427,8 @@ TestexprstringCmd(clientData, interp, argc, argv) * * TestfilelinkCmd -- * - * This procedure implements the "testfilelink" command. It is used - * to test the effects of creating and manipulating filesystem links - * in Tcl. + * This procedure implements the "testfilelink" command. It is used to + * test the effects of creating and manipulating filesystem links in Tcl. * * Results: * A standard Tcl result. @@ -2517,35 +2452,35 @@ TestfilelinkCmd(clientData, interp, objc, objv) Tcl_WrongNumArgs(interp, 1, objv, "source ?target?"); return TCL_ERROR; } - + if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) { return TCL_ERROR; } - + if (objc == 3) { /* Create link from source to target */ - contents = Tcl_FSLink(objv[1], objv[2], + contents = Tcl_FSLink(objv[1], objv[2], TCL_CREATE_SYMBOLIC_LINK|TCL_CREATE_HARD_LINK); if (contents == NULL) { - Tcl_AppendResult(interp, "could not create link from \"", - Tcl_GetString(objv[1]), "\" to \"", - Tcl_GetString(objv[2]), "\": ", - Tcl_PosixError(interp), (char *) NULL); + Tcl_AppendResult(interp, "could not create link from \"", + Tcl_GetString(objv[1]), "\" to \"", + Tcl_GetString(objv[2]), "\": ", + Tcl_PosixError(interp), NULL); return TCL_ERROR; } } else { /* Read link */ contents = Tcl_FSLink(objv[1], NULL, 0); if (contents == NULL) { - Tcl_AppendResult(interp, "could not read link \"", - Tcl_GetString(objv[1]), "\": ", - Tcl_PosixError(interp), (char *) NULL); + Tcl_AppendResult(interp, "could not read link \"", + Tcl_GetString(objv[1]), "\": ", + Tcl_PosixError(interp), NULL); return TCL_ERROR; } } Tcl_SetObjResult(interp, contents); if (objc == 2) { - /* + /* * If we are creating a link, this will actually just * be objv[3], and we don't own it */ @@ -2579,10 +2514,10 @@ TestgetassocdataCmd(clientData, interp, argc, argv) CONST char **argv; /* Argument strings. */ { char *res; - + if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " data_key\"", (char *) NULL); + " data_key\"", NULL); return TCL_ERROR; } res = (char *) Tcl_GetAssocData(interp, argv[1], NULL); @@ -2620,10 +2555,10 @@ TestgetplatformCmd(clientData, interp, argc, argv) TclPlatformType *platform; platform = TclGetPlatform(); - + if (argc != 1) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - (char *) NULL); + NULL); return TCL_ERROR; } @@ -2661,11 +2596,11 @@ TestinterpdeleteCmd(dummy, interp, argc, argv) if (argc != 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " path\"", (char *) NULL); + " path\"", NULL); return TCL_ERROR; } slaveToDelete = Tcl_GetSlave(interp, argv[1]); - if (slaveToDelete == (Tcl_Interp *) NULL) { + if (slaveToDelete == NULL) { return TCL_ERROR; } Tcl_DeleteInterp(slaveToDelete); @@ -2720,7 +2655,7 @@ TestlinkCmd(dummy, interp, argc, argv) if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " option ?arg arg arg arg arg arg arg arg arg arg arg arg", - " arg arg?\"", (char *) NULL); + " arg arg?\"", NULL); return TCL_ERROR; } if (strcmp(argv[1], "create") == 0) { @@ -2728,8 +2663,7 @@ TestlinkCmd(dummy, interp, argc, argv) Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ", argv[1], " intRO realRO boolRO stringRO wideRO charRO ucharRO shortRO", - " ushortRO uintRO longRO ulongRO floatRO uwideRO\"", - (char *) NULL); + " ushortRO uintRO longRO ulongRO floatRO uwideRO\"", NULL); return TCL_ERROR; } if (created) { @@ -2881,7 +2815,7 @@ TestlinkCmd(dummy, interp, argc, argv) } else if (strcmp(argv[1], "get") == 0) { TclFormatInt(buffer, intVar); Tcl_AppendElement(interp, buffer); - Tcl_PrintDouble((Tcl_Interp *) NULL, realVar, buffer); + Tcl_PrintDouble(NULL, realVar, buffer); Tcl_AppendElement(interp, buffer); TclFormatInt(buffer, boolVar); Tcl_AppendElement(interp, buffer); @@ -2908,7 +2842,7 @@ TestlinkCmd(dummy, interp, argc, argv) tmp = Tcl_NewLongObj((long)ulongVar); Tcl_AppendElement(interp, Tcl_GetString(tmp)); Tcl_DecrRefCount(tmp); - Tcl_PrintDouble((Tcl_Interp *) NULL, (double)floatVar, buffer); + Tcl_PrintDouble(NULL, (double)floatVar, buffer); Tcl_AppendElement(interp, buffer); tmp = Tcl_NewWideIntObj((Tcl_WideInt)uwideVar); Tcl_AppendElement(interp, Tcl_GetString(tmp)); @@ -2921,8 +2855,7 @@ TestlinkCmd(dummy, interp, argc, argv) argv[0], " ", argv[1], " intValue realValue boolValue stringValue wideValue", " charValue ucharValue shortValue ushortValue uintValue", - " longValue ulongValue floatValue uwideValue\"", - (char *) NULL); + " longValue ulongValue floatValue uwideValue\"", NULL); return TCL_ERROR; } if (argv[2][0] != 0) { @@ -3026,8 +2959,7 @@ TestlinkCmd(dummy, interp, argc, argv) argv[0], " ", argv[1], " intValue realValue boolValue stringValue wideValue", " charValue ucharValue shortValue ushortValue uintValue", - " longValue ulongValue floatValue uwideValue\"", - (char *) NULL); + " longValue ulongValue floatValue uwideValue\"", NULL); return TCL_ERROR; } if (argv[2][0] != 0) { @@ -3139,8 +3071,7 @@ TestlinkCmd(dummy, interp, argc, argv) } } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": should be create, delete, get, set, or update", - (char *) NULL); + "\": should be create, delete, get, set, or update", NULL); return TCL_ERROR; } return TCL_OK; @@ -3174,7 +3105,7 @@ TestlocaleCmd(clientData, interp, objc, objv) char *locale; static CONST char *optionStrings[] = { - "ctype", "numeric", "time", "collate", "monetary", + "ctype", "numeric", "time", "collate", "monetary", "all", NULL }; static int lcTypes[] = { @@ -3190,7 +3121,7 @@ TestlocaleCmd(clientData, interp, objc, objv) Tcl_WrongNumArgs(interp, 1, objv, "category ?locale?"); return TCL_ERROR; } - + if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, &index) != TCL_OK) { return TCL_ERROR; @@ -3261,22 +3192,22 @@ TestMathFunc2(clientData, interp, args, resultPtr) ClientData clientData; /* Integer value to return. */ Tcl_Interp *interp; /* Used to report errors. */ Tcl_Value *args; /* Points to an array of two - * Tcl_Value structs for the + * Tcl_Value structs for the * two arguments. */ Tcl_Value *resultPtr; /* Where to store the result. */ { int result = TCL_OK; - + /* * Return the maximum of the two arguments with the correct type. */ - + if (args[0].type == TCL_INT) { int i0 = args[0].intValue; - + if (args[1].type == TCL_INT) { int i1 = args[1].intValue; - + resultPtr->type = TCL_INT; resultPtr->intValue = ((i0 > i1)? i0 : i1); } else if (args[1].type == TCL_DOUBLE) { @@ -3297,10 +3228,10 @@ TestMathFunc2(clientData, interp, args, resultPtr) } } else if (args[0].type == TCL_DOUBLE) { double d0 = args[0].doubleValue; - + if (args[1].type == TCL_INT) { double d1 = args[1].intValue; - + resultPtr->type = TCL_DOUBLE; resultPtr->doubleValue = ((d0 > d1)? d0 : d1); } else if (args[1].type == TCL_DOUBLE) { @@ -3319,10 +3250,10 @@ TestMathFunc2(clientData, interp, args, resultPtr) } } else if (args[0].type == TCL_WIDE_INT) { Tcl_WideInt w0 = args[0].wideValue; - + if (args[1].type == TCL_INT) { Tcl_WideInt w1 = Tcl_LongAsWide(args[1].intValue); - + resultPtr->type = TCL_WIDE_INT; resultPtr->wideValue = ((w0 > w1)? w0 : w1); } else if (args[1].type == TCL_DOUBLE) { @@ -3519,16 +3450,15 @@ PrintParse(interp, parsePtr) objPtr = Tcl_GetObjResult(interp); if (parsePtr->commentSize > 0) { - Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr, + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(parsePtr->commentStart, parsePtr->commentSize)); } else { - Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr, - Tcl_NewStringObj("-", 1)); + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj("-", 1)); } - Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr, + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize)); - Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr, + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(parsePtr->numWords)); for (i = 0; i < parsePtr->numTokens; i++) { tokenPtr = &parsePtr->tokenPtr[i]; @@ -3564,14 +3494,14 @@ PrintParse(interp, parsePtr) typeString = "??"; break; } - Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr, + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(typeString, -1)); - Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr, + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(tokenPtr->start, tokenPtr->size)); - Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr, + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(tokenPtr->numComponents)); } - Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr, + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(parsePtr->commandStart + parsePtr->commandSize, -1)); } @@ -3685,10 +3615,10 @@ TestparsevarnameObjCmd(clientData, interp, objc, objv) * * TestregexpObjCmd -- * - * This procedure implements the "testregexp" command. It is - * used to give a direct interface for regexp flags. It's identical - * to Tcl_RegexpObjCmd except for the -xflags option, and the - * consequences thereof (including the REG_EXPECT kludge). + * This procedure implements the "testregexp" command. It is used to give + * a direct interface for regexp flags. It's identical to + * Tcl_RegexpObjCmd except for the -xflags option, and the consequences + * thereof (including the REG_EXPECT kludge). * * Results: * A standard Tcl result. @@ -3717,7 +3647,7 @@ TestregexpObjCmd(dummy, interp, objc, objv) "-indices", "-nocase", "-about", "-expanded", "-line", "-linestop", "-lineanchor", "-xflags", - "--", (char *) NULL + "--", NULL }; enum options { REGEXP_INDICES, REGEXP_NOCASE, REGEXP_ABOUT, REGEXP_EXPANDED, @@ -3731,7 +3661,7 @@ TestregexpObjCmd(dummy, interp, objc, objv) cflags = REG_ADVANCED; eflags = 0; hasxflags = 0; - + for (i = 1; i < objc; i++) { char *name; int index; @@ -3822,9 +3752,9 @@ TestregexpObjCmd(dummy, interp, objc, objv) if (match == 0) { /* * Set the interpreter's object result to an integer object w/ - * value 0. + * value 0. */ - + Tcl_SetIntObj(Tcl_GetObjResult(interp), 0); if (objc > 2 && (cflags®_EXPECT) && indices) { char *varName; @@ -3838,7 +3768,7 @@ TestregexpObjCmd(dummy, interp, objc, objv) value = Tcl_SetVar(interp, varName, resinfo, 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", - varName, "\"", (char *) NULL); + varName, "\"", NULL); return TCL_ERROR; } } else if (cflags & TCL_REG_CANMATCH) { @@ -3852,7 +3782,7 @@ TestregexpObjCmd(dummy, interp, objc, objv) value = Tcl_SetVar(interp, varName, resinfo, 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", - varName, "\"", (char *) NULL); + varName, "\"", NULL); return TCL_ERROR; } } @@ -3871,7 +3801,7 @@ TestregexpObjCmd(dummy, interp, objc, objv) for (i = 0; i < objc; i++) { int start, end; Tcl_Obj *newPtr, *varPtr, *valuePtr; - + varPtr = objv[i]; ii = ((cflags®_EXPECT) && i == objc-1) ? -1 : i; if (indices) { @@ -3888,10 +3818,10 @@ TestregexpObjCmd(dummy, interp, objc, objv) } /* - * Adjust index so it refers to the last character in the - * match instead of the first character after the match. + * Adjust index so it refers to the last character in the match + * instead of the first character after the match. */ - + if (end >= 0) { end--; } @@ -3915,15 +3845,15 @@ TestregexpObjCmd(dummy, interp, objc, objv) if (valuePtr == NULL) { Tcl_DecrRefCount(newPtr); Tcl_AppendResult(interp, "couldn't set variable \"", - Tcl_GetString(varPtr), "\"", (char *) NULL); + Tcl_GetString(varPtr), "\"", NULL); return TCL_ERROR; } } /* - * Set the interpreter's object result to an integer object w/ value 1. + * Set the interpreter's object result to an integer object w/ value 1. */ - + Tcl_SetIntObj(Tcl_GetObjResult(interp), 1); return TCL_OK; } @@ -4092,10 +4022,10 @@ TestsetassocdataCmd(clientData, interp, argc, argv) char *buf; char *oldData; Tcl_InterpDeleteProc *procPtr; - + if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " data_key data_item\"", (char *) NULL); + " data_key data_item\"", NULL); return TCL_ERROR; } @@ -4111,8 +4041,8 @@ TestsetassocdataCmd(clientData, interp, argc, argv) if ((oldData != NULL) && (procPtr == CleanupTestSetassocdataTests)) { ckfree(oldData); } - - Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests, + + Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests, (ClientData) buf); return TCL_OK; } @@ -4146,10 +4076,10 @@ TestsetplatformCmd(clientData, interp, argc, argv) TclPlatformType *platform; platform = TclGetPlatform(); - + if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " platform\"", (char *) NULL); + " platform\"", NULL); return TCL_ERROR; } @@ -4160,7 +4090,7 @@ TestsetplatformCmd(clientData, interp, argc, argv) *platform = TCL_PLATFORM_WINDOWS; } else { Tcl_AppendResult(interp, "unsupported platform: should be one of ", - "unix, or windows", (char *) NULL); + "unix, or windows", NULL); return TCL_ERROR; } return TCL_OK; @@ -4195,7 +4125,7 @@ TeststaticpkgCmd(dummy, interp, argc, argv) if (argc != 4) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " pkgName safe loaded\"", (char *) NULL); + argv[0], " pkgName safe loaded\"", NULL); return TCL_ERROR; } if (Tcl_GetInt(interp, argv[2], &safe) != TCL_OK) { @@ -4247,7 +4177,7 @@ TesttranslatefilenameCmd(dummy, interp, argc, argv) if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " path\"", (char *) NULL); + argv[0], " path\"", NULL); return TCL_ERROR; } result = Tcl_TranslateFileName(interp, argv[1], &buffer); @@ -4285,10 +4215,10 @@ TestupvarCmd(dummy, interp, argc, argv) CONST char **argv; /* Argument strings. */ { int flags = 0; - + if ((argc != 5) && (argc != 6)) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " level name ?name2? dest global\"", (char *) NULL); + argv[0], " level name ?name2? dest global\"", NULL); return TCL_ERROR; } @@ -4305,8 +4235,8 @@ TestupvarCmd(dummy, interp, argc, argv) } else if (strcmp(argv[5], "namespace") == 0) { flags = TCL_NAMESPACE_ONLY; } - return Tcl_UpVar2(interp, argv[1], argv[2], - (argv[3][0] == 0) ? (char *) NULL : argv[3], argv[4], + return Tcl_UpVar2(interp, argv[1], argv[2], + (argv[3][0] == 0) ? NULL : argv[3], argv[4], flags); } } @@ -4316,9 +4246,8 @@ TestupvarCmd(dummy, interp, argc, argv) * * TestseterrorcodeCmd -- * - * This procedure implements the "testseterrorcodeCmd". - * This tests up to five elements passed to the - * Tcl_SetErrorCode command. + * This procedure implements the "testseterrorcodeCmd". This tests up to + * five elements passed to the Tcl_SetErrorCode command. * * Results: * A standard Tcl result. Always returns TCL_ERROR so that @@ -4408,23 +4337,23 @@ TestfeventCmd(clientData, interp, argc, argv) if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option ?arg arg ...?", (char *) NULL); + " option ?arg arg ...?", NULL); return TCL_ERROR; } if (strcmp(argv[1], "cmd") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " cmd script", (char *) NULL); + " cmd script", NULL); return TCL_ERROR; } - if (interp2 != (Tcl_Interp *) NULL) { + if (interp2 != NULL) { code = Tcl_GlobalEval(interp2, argv[2]); Tcl_SetObjResult(interp, Tcl_GetObjResult(interp2)); return code; } else { Tcl_AppendResult(interp, "called \"testfevent code\" before \"testfevent create\"", - (char *) NULL); + NULL); return TCL_ERROR; } } else if (strcmp(argv[1], "create") == 0) { @@ -4447,7 +4376,7 @@ TestfeventCmd(clientData, interp, argc, argv) Tcl_RegisterChannel(interp2, chan); } } - + return TCL_OK; } @@ -4459,7 +4388,7 @@ TestfeventCmd(clientData, interp, argc, argv) * Calls the panic routine. * * Results: - * Always returns TCL_OK. + * Always returns TCL_OK. * * Side effects: * May exit application. @@ -4475,7 +4404,7 @@ TestpanicCmd(dummy, interp, argc, argv) CONST char **argv; /* Argument strings. */ { CONST char *argString; - + /* * Put the arguments into a var args structure * Append all of the arguments together separated by spaces @@ -4484,7 +4413,7 @@ TestpanicCmd(dummy, interp, argc, argv) argString = Tcl_Merge(argc-1, argv+1); Tcl_Panic(argString); ckfree((char *)argString); - + return TCL_OK; } @@ -4493,10 +4422,10 @@ TestpanicCmd(dummy, interp, argc, argv) * * TestchmodCmd -- * - * 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. Otehrwise, the file is made read-write. + * 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. Otehrwise, the + * file is made read-write. * * Results: * A standard Tcl result. @@ -4506,7 +4435,7 @@ TestpanicCmd(dummy, interp, argc, argv) * *--------------------------------------------------------------------------- */ - + static int TestchmodCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ @@ -4520,7 +4449,7 @@ TestchmodCmd(dummy, interp, argc, argv) if (argc < 2) { usage: Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " mode file ?file ...?", (char *) NULL); + " mode file ?file ...?", NULL); return TCL_ERROR; } @@ -4532,14 +4461,14 @@ TestchmodCmd(dummy, interp, argc, argv) for (i = 2; i < argc; i++) { Tcl_DString buffer; CONST char *translated; - + translated = Tcl_TranslateFileName(interp, argv[i], &buffer); if (translated == NULL) { return TCL_ERROR; } if (chmod(translated, (unsigned) mode) != 0) { Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp), - (char *) NULL); + NULL); return TCL_ERROR; } Tcl_DStringFree(&buffer); @@ -4557,7 +4486,7 @@ TestfileCmd(dummy, interp, argc, argv) int force, i, j, result; Tcl_Obj *error = NULL; char *subcmd; - + if (argc < 3) { return TCL_ERROR; } @@ -4580,7 +4509,7 @@ TestfileCmd(dummy, interp, argc, argv) } subcmd = Tcl_GetString(argv[1]); - + if (strcmp(subcmd, "mv") == 0) { result = TclpObjRenameFile(argv[i], argv[i + 1]); } else if (strcmp(subcmd, "cp") == 0) { @@ -4597,7 +4526,7 @@ TestfileCmd(dummy, interp, argc, argv) result = TCL_ERROR; goto end; } - + if (result != TCL_OK) { if (error != NULL) { if (Tcl_GetString(error)[0] != '\0') { @@ -4605,7 +4534,7 @@ TestfileCmd(dummy, interp, argc, argv) } Tcl_DecrRefCount(error); } - Tcl_AppendResult(interp, Tcl_ErrnoId(), (char *) NULL); + Tcl_AppendResult(interp, Tcl_ErrnoId(), NULL); } end: @@ -4648,7 +4577,7 @@ TestgetvarfullnameCmd(dummy, interp, objc, objv) Tcl_WrongNumArgs(interp, 1, objv, "name scope"); return TCL_ERROR; } - + name = Tcl_GetString(objv[1]); arg = Tcl_GetString(objv[2]); @@ -4659,15 +4588,14 @@ TestgetvarfullnameCmd(dummy, interp, objc, objv) } /* - * This command, like any other created with Tcl_Create[Obj]Command, - * runs in the global namespace. As a "namespace-aware" command that - * needs to run in a particular namespace, it must activate that - * namespace itself. + * This command, like any other created with Tcl_Create[Obj]Command, runs + * in the global namespace. As a "namespace-aware" command that needs to + * run in a particular namespace, it must activate that namespace itself. */ if (flags == TCL_NAMESPACE_ONLY) { - namespacePtr = Tcl_FindNamespace(interp, "::test_ns_var", - (Tcl_Namespace *) NULL, TCL_LEAVE_ERR_MSG); + namespacePtr = Tcl_FindNamespace(interp, "::test_ns_var", NULL, + TCL_LEAVE_ERR_MSG); if (namespacePtr == NULL) { return TCL_ERROR; } @@ -4677,8 +4605,8 @@ TestgetvarfullnameCmd(dummy, interp, objc, objv) return result; } } - - variable = Tcl_FindNamespaceVar(interp, name, (Tcl_Namespace *) NULL, + + variable = Tcl_FindNamespaceVar(interp, name, NULL, (flags | TCL_LEAVE_ERR_MSG)); if (flags == TCL_NAMESPACE_ONLY) { @@ -4696,10 +4624,9 @@ TestgetvarfullnameCmd(dummy, interp, objc, objv) * * GetTimesCmd -- * - * This procedure implements the "gettimes" command. It is - * used for computing the time needed for various basic operations - * such as reading variables, allocating memory, sprintf, converting - * variables, etc. + * This procedure implements the "gettimes" command. It is used for + * computing the time needed for various basic operations such as reading + * variables, allocating memory, sprintf, converting variables, etc. * * Results: * A standard Tcl result. @@ -4736,7 +4663,7 @@ GetTimesCmd(unused, interp, argc, argv) Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per alloc+free\n", timePer/100000); - + /* alloc 5000 times */ fprintf(stderr, "alloc 5000 6 word items\n"); objv = (Tcl_Obj **) ckalloc(5000 * sizeof(Tcl_Obj *)); @@ -4747,7 +4674,7 @@ GetTimesCmd(unused, interp, argc, argv) Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per alloc\n", timePer/5000); - + /* free 5000 times */ fprintf(stderr, "free 5000 6 word items\n"); Tcl_GetTime(&start); @@ -4767,7 +4694,7 @@ GetTimesCmd(unused, interp, argc, argv) Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per Tcl_NewObj\n", timePer/5000); - + /* Tcl_DecrRefCount 5000 times */ fprintf(stderr, "Tcl_DecrRefCount 5000 times\n"); Tcl_GetTime(&start); @@ -4805,7 +4732,7 @@ GetTimesCmd(unused, interp, argc, argv) fprintf(stderr, " %.3f usec per Tcl_GetIntFromObj of \"12345\"\n", timePer/100000); Tcl_DecrRefCount(objPtr); - + /* Tcl_GetInt 100000 times */ fprintf(stderr, "Tcl_GetInt of \"12345\" 100000 times\n"); Tcl_GetTime(&start); @@ -4868,7 +4795,7 @@ GetTimesCmd(unused, interp, argc, argv) timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per Tcl_GetVar of a==\"12345\"\n", timePer/100000); - + Tcl_ResetResult(interp); return TCL_OK; } @@ -4957,7 +4884,7 @@ TestsetCmd(data, interp, argc, argv) if (argc == 2) { Tcl_SetResult(interp, "before get", TCL_STATIC); - value = Tcl_GetVar2(interp, argv[1], (char *) NULL, flags); + value = Tcl_GetVar2(interp, argv[1], NULL, flags); if (value == NULL) { return TCL_ERROR; } @@ -4965,7 +4892,7 @@ TestsetCmd(data, interp, argc, argv) return TCL_OK; } else if (argc == 3) { Tcl_SetResult(interp, "before set", TCL_STATIC); - value = Tcl_SetVar2(interp, argv[1], (char *) NULL, argv[2], flags); + value = Tcl_SetVar2(interp, argv[1], NULL, argv[2], flags); if (value == NULL) { return TCL_ERROR; } @@ -4973,7 +4900,7 @@ TestsetCmd(data, interp, argc, argv) return TCL_OK; } else { Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " varName ?newValue?\"", (char *) NULL); + argv[0], " varName ?newValue?\"", NULL); return TCL_ERROR; } } @@ -4983,9 +4910,8 @@ TestsetCmd(data, interp, argc, argv) * * TestsaveresultCmd -- * - * Implements the "testsaveresult" cmd that is used when testing - * the Tcl_SaveResult, Tcl_RestoreResult, and - * Tcl_DiscardResult interfaces. + * Implements the "testsaveresult" cmd that is used when testing the + * Tcl_SaveResult, Tcl_RestoreResult, and Tcl_DiscardResult interfaces. * * Results: * A standard Tcl result. @@ -5139,7 +5065,7 @@ TeststatprocCmd (dummy, interp, argc, argv) if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " option arg\"", (char *) NULL); + argv[0], " option arg\"", NULL); return TCL_ERROR; } @@ -5154,8 +5080,7 @@ TeststatprocCmd (dummy, interp, argc, argv) } else { Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ", "must be TclpStat, ", - "TestStatProc1, TestStatProc2, or TestStatProc3", - (char *) NULL); + "TestStatProc1, TestStatProc2, or TestStatProc3", NULL); return TCL_ERROR; } @@ -5163,8 +5088,7 @@ TeststatprocCmd (dummy, interp, argc, argv) if (proc == PretendTclpStat) { Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ", "must be ", - "TestStatProc1, TestStatProc2, or TestStatProc3", - (char *) NULL); + "TestStatProc1, TestStatProc2, or TestStatProc3", NULL); return TCL_ERROR; } retVal = TclStatInsertProc(proc); @@ -5172,13 +5096,13 @@ TeststatprocCmd (dummy, interp, argc, argv) retVal = TclStatDeleteProc(proc); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": ", - "must be insert or delete", (char *) NULL); + "must be insert or delete", NULL); return TCL_ERROR; } if (retVal == TCL_ERROR) { Tcl_AppendResult(interp, "\"", argv[2], "\": ", - "could not be ", argv[1], "ed", (char *) NULL); + "could not be ", argv[1], "ed", NULL); } return retVal; @@ -5234,11 +5158,11 @@ static int PretendTclpStat(path, buf) # undef OUT_OF_URANGE /* - * Copy across all supported fields, with possible type - * coercions on those fields that change between the normal - * and lf64 versions of the stat structure (on Solaris at - * least.) This is slow when the structure sizes coincide, - * but that's what you get for mixing interfaces... + * Copy across all supported fields, with possible type coercions on + * those fields that change between the normal and lf64 versions of + * the stat structure (on Solaris at least.) This is slow when the + * structure sizes coincide, but that's what you get for mixing + * interfaces... */ buf->st_mode = realBuf.st_mode; @@ -5439,7 +5363,7 @@ TestaccessprocCmd (dummy, interp, argc, argv) if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " option arg\"", (char *) NULL); + argv[0], " option arg\"", NULL); return TCL_ERROR; } @@ -5454,17 +5378,15 @@ TestaccessprocCmd (dummy, interp, argc, argv) } else { Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ", "must be TclpAccess, ", - "TestAccessProc1, TestAccessProc2, or TestAccessProc3", - (char *) NULL); + "TestAccessProc1, TestAccessProc2, or TestAccessProc3", NULL); return TCL_ERROR; } if (strcmp(argv[1], "insert") == 0) { if (proc == PretendTclpAccess) { - Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ", - "must be ", + Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": must be ", "TestAccessProc1, TestAccessProc2, or TestAccessProc3", - (char *) NULL); + NULL); return TCL_ERROR; } retVal = TclAccessInsertProc(proc); @@ -5472,13 +5394,13 @@ TestaccessprocCmd (dummy, interp, argc, argv) retVal = TclAccessDeleteProc(proc); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": ", - "must be insert or delete", (char *) NULL); + "must be insert or delete", NULL); return TCL_ERROR; } if (retVal == TCL_ERROR) { Tcl_AppendResult(interp, "\"", argv[2], "\": ", - "could not be ", argv[1], "ed", (char *) NULL); + "could not be ", argv[1], "ed", NULL); } return retVal; @@ -5551,7 +5473,7 @@ TestopenfilechannelprocCmd (dummy, interp, argc, argv) if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " option arg\"", (char *) NULL); + argv[0], " option arg\"", NULL); return TCL_ERROR; } @@ -5567,8 +5489,7 @@ TestopenfilechannelprocCmd (dummy, interp, argc, argv) Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ", "must be TclpOpenFileChannel, ", "TestOpenFileChannelProc1, TestOpenFileChannelProc2, or ", - "TestOpenFileChannelProc3", - (char *) NULL); + "TestOpenFileChannelProc3", NULL); return TCL_ERROR; } @@ -5577,8 +5498,7 @@ TestopenfilechannelprocCmd (dummy, interp, argc, argv) Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ", "must be ", "TestOpenFileChannelProc1, TestOpenFileChannelProc2, or ", - "TestOpenFileChannelProc3", - (char *) NULL); + "TestOpenFileChannelProc3", NULL); return TCL_ERROR; } retVal = TclOpenFileChannelInsertProc(proc); @@ -5586,13 +5506,13 @@ TestopenfilechannelprocCmd (dummy, interp, argc, argv) retVal = TclOpenFileChannelDeleteProc(proc); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": ", - "must be insert or delete", (char *) NULL); + "must be insert or delete", NULL); return TCL_ERROR; } if (retVal == TCL_ERROR) { Tcl_AppendResult(interp, "\"", argv[2], "\": ", - "could not be ", argv[1], "ed", (char *) NULL); + "could not be ", argv[1], "ed", NULL); } return retVal; @@ -5623,11 +5543,10 @@ PretendTclpOpenFileChannel(interp, fileName, modeString, permissions) if (ret != NULL) { if (seekFlag) { if (Tcl_Seek(ret, (Tcl_WideInt)0, SEEK_END) < (Tcl_WideInt)0) { - if (interp != (Tcl_Interp *) NULL) { + if (interp != NULL) { Tcl_AppendResult(interp, - "could not seek to end of file while opening \"", - fileName, "\": ", - Tcl_PosixError(interp), (char *) NULL); + "could not seek to end of file while opening \"", + fileName, "\": ", Tcl_PosixError(interp), NULL); } Tcl_Close(NULL, ret); return NULL; @@ -5650,7 +5569,7 @@ TestOpenFileChannelProc1(interp, fileName, modeString, permissions) { CONST char *expectname="testOpenFileChannel1%.fil"; Tcl_DString ds; - + Tcl_DStringInit(&ds); Tcl_JoinPath(1, &expectname, &ds); @@ -5678,7 +5597,7 @@ TestOpenFileChannelProc2(interp, fileName, modeString, permissions) { CONST char *expectname="testOpenFileChannel2%.fil"; Tcl_DString ds; - + Tcl_DStringInit(&ds); Tcl_JoinPath(1, &expectname, &ds); @@ -5706,7 +5625,7 @@ TestOpenFileChannelProc3(interp, fileName, modeString, permissions) { CONST char *expectname="testOpenFileChannel3%.fil"; Tcl_DString ds; - + Tcl_DStringInit(&ds); Tcl_JoinPath(1, &expectname, &ds); @@ -5756,16 +5675,16 @@ TestChannelCmd(clientData, interp, argc, argv) int IOQueued; /* How much IO is queued inside channel? */ char buf[TCL_INTEGER_SPACE];/* For sprintf. */ int mode; /* rw mode of the channel */ - + if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " subcommand ?additional args..?\"", (char *) NULL); + " subcommand ?additional args..?\"", NULL); return TCL_ERROR; } cmdName = argv[1]; len = strlen(cmdName); - chanPtr = (Channel *) NULL; + chanPtr = NULL; if (argc > 2) { if ((cmdName[0] == 's') && (strncmp(cmdName, "splice", len) == 0)) { @@ -5833,11 +5752,10 @@ TestChannelCmd(clientData, interp, argc, argv) } /* - * "cut" is actually more a simplified detach facility as provided - * by the Thread package. Without the safeguards of a regular - * command (no checking that the command is truly cut'able, no - * mutexes for thread-safety). Its complementary command is - * "splice", see below. + * "cut" is actually more a simplified detach facility as provided by the + * Thread package. Without the safeguards of a regular command (no + * checking that the command is truly cut'able, no mutexes for + * thread-safety). Its complementary command is "splice", see below. */ if ((cmdName[0] == 'c') && (strncmp(cmdName, "cut", len) == 0)) { @@ -5845,11 +5763,11 @@ TestChannelCmd(clientData, interp, argc, argv) if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " cut channelName\"", (char *) NULL); + " cut channelName\"", NULL); return TCL_ERROR; } - Tcl_RegisterChannel((Tcl_Interp *) NULL, chan); /* prevent closing */ + Tcl_RegisterChannel(NULL, chan); /* prevent closing */ Tcl_UnregisterChannel(interp, chan); Tcl_CutChannel(chan); @@ -5868,7 +5786,7 @@ TestChannelCmd(clientData, interp, argc, argv) (strncmp(cmdName, "clearchannelhandlers", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " clearchannelhandlers channelName\"", (char *) NULL); + " clearchannelhandlers channelName\"", NULL); return TCL_ERROR; } Tcl_ClearChannelHandlers(chan); @@ -5878,7 +5796,7 @@ TestChannelCmd(clientData, interp, argc, argv) if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " info channelName\"", (char *) NULL); + " info channelName\"", NULL); return TCL_ERROR; } Tcl_AppendElement(interp, argv[2]); @@ -5953,11 +5871,11 @@ TestChannelCmd(clientData, interp, argc, argv) IOQueued = Tcl_InputBuffered(chan); TclFormatInt(buf, IOQueued); Tcl_AppendElement(interp, buf); - + IOQueued = Tcl_OutputBuffered(chan); TclFormatInt(buf, IOQueued); Tcl_AppendElement(interp, buf); - + TclFormatInt(buf, (int)Tcl_Tell(chan)); Tcl_AppendElement(interp, buf); @@ -5970,45 +5888,43 @@ TestChannelCmd(clientData, interp, argc, argv) if ((cmdName[0] == 'i') && (strncmp(cmdName, "inputbuffered", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", - (char *) NULL); + Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } IOQueued = Tcl_InputBuffered(chan); TclFormatInt(buf, IOQueued); - Tcl_AppendResult(interp, buf, (char *) NULL); + Tcl_AppendResult(interp, buf, NULL); return TCL_OK; } if ((cmdName[0] == 'i') && (strncmp(cmdName, "isshared", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (char *) NULL); + Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } - + TclFormatInt(buf, Tcl_IsChannelShared(chan)); - Tcl_AppendResult(interp, buf, (char *) NULL); + Tcl_AppendResult(interp, buf, NULL); return TCL_OK; } if ((cmdName[0] == 'i') && (strncmp(cmdName, "isstandard", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (char *) NULL); + Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } - + TclFormatInt(buf, Tcl_IsStandardChannel(chan)); - Tcl_AppendResult(interp, buf, (char *) NULL); + Tcl_AppendResult(interp, buf, NULL); return TCL_OK; } if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", - (char *) NULL); + Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } - + if (statePtr->flags & TCL_READABLE) { Tcl_AppendElement(interp, "read"); } else { @@ -6021,36 +5937,34 @@ TestChannelCmd(clientData, interp, argc, argv) } return TCL_OK; } - + if ((cmdName[0] == 'm') && (strncmp(cmdName, "mthread", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", - (char *) NULL); + Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } TclFormatInt(buf, (long) Tcl_GetChannelThread(chan)); - Tcl_AppendResult(interp, buf, (char *) NULL); + Tcl_AppendResult(interp, buf, NULL); return TCL_OK; } if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", - (char *) NULL); + Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } - Tcl_AppendResult(interp, statePtr->channelName, (char *) NULL); + Tcl_AppendResult(interp, statePtr->channelName, NULL); return TCL_OK; } if ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) { hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL); - if (hTblPtr == (Tcl_HashTable *) NULL) { + if (hTblPtr == NULL) { return TCL_OK; } for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); - hPtr != (Tcl_HashEntry *) NULL; + hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr)); } @@ -6060,38 +5974,35 @@ TestChannelCmd(clientData, interp, argc, argv) if ((cmdName[0] == 'o') && (strncmp(cmdName, "outputbuffered", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", - (char *) NULL); + Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } IOQueued = Tcl_OutputBuffered(chan); TclFormatInt(buf, IOQueued); - Tcl_AppendResult(interp, buf, (char *) NULL); + Tcl_AppendResult(interp, buf, NULL); return TCL_OK; } if ((cmdName[0] == 'q') && (strncmp(cmdName, "queuedcr", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", - (char *) NULL); + Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } Tcl_AppendResult(interp, - (statePtr->flags & INPUT_SAW_CR) ? "1" : "0", - (char *) NULL); + (statePtr->flags & INPUT_SAW_CR) ? "1" : "0", NULL); return TCL_OK; } if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) { hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL); - if (hTblPtr == (Tcl_HashTable *) NULL) { + if (hTblPtr == NULL) { return TCL_OK; } for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); - hPtr != (Tcl_HashEntry *) NULL; + hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { chanPtr = (Channel *) Tcl_GetHashValue(hPtr); statePtr = chanPtr->state; @@ -6104,56 +6015,52 @@ TestChannelCmd(clientData, interp, argc, argv) if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", - (char *) NULL); + Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } - + TclFormatInt(buf, statePtr->refCount); - Tcl_AppendResult(interp, buf, (char *) NULL); + Tcl_AppendResult(interp, buf, NULL); return TCL_OK; } /* - * "splice" is actually more a simplified attach facility as - * provided by the Thread package. Without the safeguards of a - * regular command (no checking that the command is truly - * cut'able, no mutexes for thread-safety). Its complementary - * command is "cut", see above. + * "splice" is actually more a simplified attach facility as provided by + * the Thread package. Without the safeguards of a regular command (no + * checking that the command is truly cut'able, no mutexes for + * thread-safety). Its complementary command is "cut", see above. */ if ((cmdName[0] == 's') && (strncmp(cmdName, "splice", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (char *) NULL); + Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } Tcl_SpliceChannel(chan); Tcl_RegisterChannel(interp, chan); - Tcl_UnregisterChannel((Tcl_Interp *)NULL, chan); + Tcl_UnregisterChannel(NULL, chan); return TCL_OK; } if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", - (char *) NULL); + Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; } - Tcl_AppendResult(interp, Tcl_ChannelName(chanPtr->typePtr), - (char *) NULL); + Tcl_AppendResult(interp, Tcl_ChannelName(chanPtr->typePtr), NULL); return TCL_OK; } if ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) { hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL); - if (hTblPtr == (Tcl_HashTable *) NULL) { + if (hTblPtr == NULL) { return TCL_OK; } for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); - hPtr != (Tcl_HashEntry *) NULL; + hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { chanPtr = (Channel *) Tcl_GetHashValue(hPtr); statePtr = chanPtr->state; @@ -6171,12 +6078,12 @@ TestChannelCmd(clientData, interp, argc, argv) if (argc != 5) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " transform channelId -command cmd\"", (char *) NULL); + " transform channelId -command cmd\"", NULL); return TCL_ERROR; } if (strcmp(argv[3], "-command") != 0) { Tcl_AppendResult(interp, "bad argument \"", argv[3], - "\": should be \"-command\"", (char *) NULL); + "\": should be \"-command\"", NULL); return TCL_ERROR; } @@ -6191,7 +6098,7 @@ TestChannelCmd(clientData, interp, argc, argv) if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " unstack channel\"", (char *) NULL); + " unstack channel\"", NULL); return TCL_ERROR; } return Tcl_UnstackChannel(interp, chan); @@ -6199,8 +6106,7 @@ TestChannelCmd(clientData, interp, argc, argv) Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ", "cut, clearchannelhandlers, info, isshared, mode, open, " - "readable, splice, writable, transform, unstack", - (char *) NULL); + "readable, splice, writable, transform, unstack", NULL); return TCL_ERROR; } @@ -6209,8 +6115,8 @@ TestChannelCmd(clientData, interp, argc, argv) * * TestChannelEventCmd -- * - * This procedure implements the "testchannelevent" command. It is - * used to test the Tcl channel event mechanism. + * This procedure implements the "testchannelevent" command. It is used + * to test the Tcl channel event mechanism. * * Results: * A standard Tcl result. @@ -6238,11 +6144,11 @@ TestChannelEventCmd(dummy, interp, argc, argv) if ((argc < 3) || (argc > 5)) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelName cmd ?arg1? ?arg2?\"", (char *) NULL); + " channelName cmd ?arg1? ?arg2?\"", NULL); return TCL_ERROR; } chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL); - if (chanPtr == (Channel *) NULL) { + if (chanPtr == NULL) { return TCL_ERROR; } statePtr = chanPtr->state; @@ -6252,7 +6158,7 @@ TestChannelEventCmd(dummy, interp, argc, argv) if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) { if (argc != 5) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelName add eventSpec script\"", (char *) NULL); + " channelName add eventSpec script\"", NULL); return TCL_ERROR; } if (strcmp(argv[3], "readable") == 0) { @@ -6263,7 +6169,7 @@ TestChannelEventCmd(dummy, interp, argc, argv) mask = 0; } else { Tcl_AppendResult(interp, "bad event name \"", argv[3], - "\": must be readable, writable, or none", (char *) NULL); + "\": must be readable, writable, or none", NULL); return TCL_ERROR; } @@ -6271,7 +6177,7 @@ TestChannelEventCmd(dummy, interp, argc, argv) sizeof(EventScriptRecord)); esPtr->nextPtr = statePtr->scriptRecordPtr; statePtr->scriptRecordPtr = esPtr; - + esPtr->chanPtr = chanPtr; esPtr->interp = interp; esPtr->mask = mask; @@ -6280,14 +6186,14 @@ TestChannelEventCmd(dummy, interp, argc, argv) Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask, TclChannelEventScriptInvoker, (ClientData) esPtr); - + return TCL_OK; } if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) { if (argc != 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelName delete index\"", (char *) NULL); + " channelName delete index\"", NULL); return TCL_ERROR; } if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) { @@ -6295,29 +6201,29 @@ TestChannelEventCmd(dummy, interp, argc, argv) } if (index < 0) { Tcl_AppendResult(interp, "bad event index: ", argv[3], - ": must be nonnegative", (char *) NULL); + ": must be nonnegative", NULL); return TCL_ERROR; } for (i = 0, esPtr = statePtr->scriptRecordPtr; - (i < index) && (esPtr != (EventScriptRecord *) NULL); + (i < index) && (esPtr != NULL); i++, esPtr = esPtr->nextPtr) { /* Empty loop body. */ } - if (esPtr == (EventScriptRecord *) NULL) { + if (esPtr == NULL) { Tcl_AppendResult(interp, "bad event index ", argv[3], - ": out of range", (char *) NULL); + ": out of range", NULL); return TCL_ERROR; } if (esPtr == statePtr->scriptRecordPtr) { statePtr->scriptRecordPtr = esPtr->nextPtr; } else { for (prevEsPtr = statePtr->scriptRecordPtr; - (prevEsPtr != (EventScriptRecord *) NULL) && + (prevEsPtr != NULL) && (prevEsPtr->nextPtr != esPtr); prevEsPtr = prevEsPtr->nextPtr) { /* Empty loop body. */ } - if (prevEsPtr == (EventScriptRecord *) NULL) { + if (prevEsPtr == NULL) { Tcl_Panic("TestChannelEventCmd: damaged event script list"); } prevEsPtr->nextPtr = esPtr->nextPtr; @@ -6333,18 +6239,18 @@ TestChannelEventCmd(dummy, interp, argc, argv) if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelName list\"", (char *) NULL); + " channelName list\"", NULL); return TCL_ERROR; } resultListPtr = Tcl_GetObjResult(interp); for (esPtr = statePtr->scriptRecordPtr; - esPtr != (EventScriptRecord *) NULL; + esPtr != NULL; esPtr = esPtr->nextPtr) { if (esPtr->mask) { Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj( (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1)); } else { - Tcl_ListObjAppendElement(interp, resultListPtr, + Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj("none", -1)); } Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr); @@ -6356,11 +6262,11 @@ TestChannelEventCmd(dummy, interp, argc, argv) if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelName removeall\"", (char *) NULL); + " channelName removeall\"", NULL); return TCL_ERROR; } for (esPtr = statePtr->scriptRecordPtr; - esPtr != (EventScriptRecord *) NULL; + esPtr != NULL; esPtr = nextEsPtr) { nextEsPtr = esPtr->nextPtr; Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, @@ -6368,14 +6274,14 @@ TestChannelEventCmd(dummy, interp, argc, argv) Tcl_DecrRefCount(esPtr->scriptPtr); ckfree((char *) esPtr); } - statePtr->scriptRecordPtr = (EventScriptRecord *) NULL; + statePtr->scriptRecordPtr = NULL; return TCL_OK; } if ((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) { if (argc != 5) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelName delete index event\"", (char *) NULL); + " channelName delete index event\"", NULL); return TCL_ERROR; } if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) { @@ -6383,17 +6289,17 @@ TestChannelEventCmd(dummy, interp, argc, argv) } if (index < 0) { Tcl_AppendResult(interp, "bad event index: ", argv[3], - ": must be nonnegative", (char *) NULL); + ": must be nonnegative", NULL); return TCL_ERROR; } for (i = 0, esPtr = statePtr->scriptRecordPtr; - (i < index) && (esPtr != (EventScriptRecord *) NULL); + (i < index) && (esPtr != NULL); i++, esPtr = esPtr->nextPtr) { /* Empty loop body. */ } - if (esPtr == (EventScriptRecord *) NULL) { + if (esPtr == NULL) { Tcl_AppendResult(interp, "bad event index ", argv[3], - ": out of range", (char *) NULL); + ": out of range", NULL); return TCL_ERROR; } @@ -6405,16 +6311,16 @@ TestChannelEventCmd(dummy, interp, argc, argv) mask = 0; } else { Tcl_AppendResult(interp, "bad event name \"", argv[4], - "\": must be readable, writable, or none", (char *) NULL); + "\": must be readable, writable, or none", NULL); return TCL_ERROR; } esPtr->mask = mask; Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask, TclChannelEventScriptInvoker, (ClientData) esPtr); return TCL_OK; - } + } Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ", - "add, delete, list, set, or removeall", (char *) NULL); + "add, delete, list, set, or removeall", NULL); return TCL_ERROR; } @@ -6452,7 +6358,7 @@ TestWrongNumArgsObjCmd(dummy, interp, objc, objv) Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC); return TCL_ERROR; } - + if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK) { return TCL_ERROR; } @@ -6461,7 +6367,7 @@ TestWrongNumArgsObjCmd(dummy, interp, objc, objv) if (length == 0) { msg = NULL; } - + if (i > objc - 3) { /* * Asked for more arguments than were given. @@ -6498,7 +6404,7 @@ TestGetIndexFromObjStructObjCmd(dummy, interp, objc, objv) Tcl_Obj *CONST objv[]; /* Argument objects. */ { char *ary[] = { - "a", "b", "c", "d", "e", "f", (char *)NULL,(char *)NULL + "a", "b", "c", "d", "e", "f", NULL, NULL }; int idx,target; @@ -6507,7 +6413,7 @@ TestGetIndexFromObjStructObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } if (Tcl_GetIndexFromObjStruct(interp, objv[1], ary, 2*sizeof(char *), - "dummy", 0, &idx) != TCL_OK) { + "dummy", 0, &idx) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[2], &target) != TCL_OK) { @@ -6517,7 +6423,7 @@ TestGetIndexFromObjStructObjCmd(dummy, interp, objc, objv) char buffer[64]; sprintf(buffer, "%d", idx); Tcl_AppendResult(interp, "index value comparison failed: got ", - buffer, NULL); + buffer, NULL); sprintf(buffer, "%d", target); Tcl_AppendResult(interp, " when ", buffer, " expected", NULL); return TCL_ERROR; @@ -6531,9 +6437,9 @@ TestGetIndexFromObjStructObjCmd(dummy, interp, objc, objv) * * TestFilesystemObjCmd -- * - * This procedure implements the "testfilesystem" command. It is - * used to test Tcl_FSRegister, Tcl_FSUnregister, and can be used - * to test that the pluggable filesystem works. + * This procedure implements the "testfilesystem" command. It is used to + * test Tcl_FSRegister, Tcl_FSUnregister, and can be used to test that + * the pluggable filesystem works. * * Results: * A standard Tcl result. @@ -6553,7 +6459,7 @@ TestFilesystemObjCmd(dummy, interp, objc, objv) { int res, boolVal; char *msg; - + if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "boolean"); return TCL_ERROR; @@ -6572,11 +6478,11 @@ TestFilesystemObjCmd(dummy, interp, objc, objv) return res; } -static int +static int TestReportInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) { static Tcl_Obj* lastPathPtr = NULL; - + if (pathPtr == lastPathPtr) { /* Reject all files second time around */ return -1; @@ -6600,16 +6506,16 @@ TestReportInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) } } -/* +/* * Simple helper function to extract the native vfs representation of a * path object, or NULL if no such representation exists. */ -static Tcl_Obj* +static Tcl_Obj* TestReportGetNativePath(Tcl_Obj* pathPtr) { return (Tcl_Obj*) Tcl_FSGetInternalRep(pathPtr, &testReportingFilesystem); } -static void +static void TestReportFreeInternalRep(ClientData clientData) { Tcl_Obj *nativeRep = (Tcl_Obj*)clientData; if (nativeRep != NULL) { @@ -6618,7 +6524,7 @@ TestReportFreeInternalRep(ClientData clientData) { } } -static ClientData +static ClientData TestReportDupInternalRep(ClientData clientData) { Tcl_Obj *original = (Tcl_Obj*)clientData; Tcl_IncrRefCount(original); @@ -6635,7 +6541,7 @@ TestReport(cmd, path, arg2) if (interp == NULL) { /* This is bad, but not much we can do about it */ } else { - /* + /* * No idea why I decided to program this up using the * old string-based API, but there you go. We should * convert it to objects. @@ -6714,8 +6620,8 @@ TestReportMatchInDirectory(interp, resultPtr, dirPtr, pattern, types) return TCL_OK; } else { TestReport("matchindirectory",dirPtr, NULL); - return Tcl_FSMatchInDirectory(interp, resultPtr, - TestReportGetNativePath(dirPtr), pattern, + return Tcl_FSMatchInDirectory(interp, resultPtr, + TestReportGetNativePath(dirPtr), pattern, types); } } @@ -6727,15 +6633,15 @@ TestReportChdir(dirName) return Tcl_FSChdir(TestReportGetNativePath(dirName)); } static int -TestReportLoadFile(interp, fileName, +TestReportLoadFile(interp, fileName, handlePtr, unloadProcPtr) Tcl_Interp *interp; /* Used for error reporting. */ Tcl_Obj *fileName; /* Name of the file containing the desired * code. */ Tcl_LoadHandle *handlePtr; /* Filled with token for dynamically loaded - * file which will be passed back to + * file which will be passed back to * (*unloadProcPtr)() to unload the file. */ - Tcl_FSUnloadFileProc **unloadProcPtr; + Tcl_FSUnloadFileProc **unloadProcPtr; /* Filled with address of Tcl_FSUnloadFileProc * function which should be used for * this file. */ @@ -6761,16 +6667,16 @@ TestReportRenameFile(src, dst) * (UTF-8). */ { TestReport("renamefile",src,dst); - return Tcl_FSRenameFile(TestReportGetNativePath(src), + return Tcl_FSRenameFile(TestReportGetNativePath(src), TestReportGetNativePath(dst)); } -static int +static int TestReportCopyFile(src, dst) Tcl_Obj *src; /* Pathname of file to be copied (UTF-8). */ Tcl_Obj *dst; /* Pathname of file to copy to (UTF-8). */ { TestReport("copyfile",src,dst); - return Tcl_FSCopyFile(TestReportGetNativePath(src), + return Tcl_FSCopyFile(TestReportGetNativePath(src), TestReportGetNativePath(dst)); } static int @@ -6792,11 +6698,11 @@ TestReportCopyDirectory(src, dst, errorPtr) Tcl_Obj *src; /* Pathname of directory to be copied * (UTF-8). */ Tcl_Obj *dst; /* Pathname of target directory (UTF-8). */ - Tcl_Obj **errorPtr; /* If non-NULL, to be filled with UTF-8 name + Tcl_Obj **errorPtr; /* If non-NULL, to be filled with UTF-8 name * of file causing error. */ { TestReport("copydirectory",src,dst); - return Tcl_FSCopyDirectory(TestReportGetNativePath(src), + return Tcl_FSCopyDirectory(TestReportGetNativePath(src), TestReportGetNativePath(dst), errorPtr); } static int @@ -6806,11 +6712,11 @@ TestReportRemoveDirectory(path, recursive, errorPtr) int recursive; /* If non-zero, removes directories that * are nonempty. Otherwise, will only remove * empty directories. */ - Tcl_Obj **errorPtr; /* If non-NULL, to be filled with UTF-8 name + Tcl_Obj **errorPtr; /* If non-NULL, to be filled with UTF-8 name * of file causing error. */ { TestReport("removedirectory",path,NULL); - return Tcl_FSRemoveDirectory(TestReportGetNativePath(path), recursive, + return Tcl_FSRemoveDirectory(TestReportGetNativePath(path), recursive, errorPtr); } static CONST char** @@ -6829,7 +6735,7 @@ TestReportFileAttrsGet(interp, index, fileName, objPtrRef) Tcl_Obj **objPtrRef; /* for output. */ { TestReport("fileattributesget",fileName,NULL); - return Tcl_FSFileAttrsGet(interp, index, + return Tcl_FSFileAttrsGet(interp, index, TestReportGetNativePath(fileName), objPtrRef); } static int @@ -6840,10 +6746,10 @@ TestReportFileAttrsSet(interp, index, fileName, objPtr) Tcl_Obj *objPtr; /* for input. */ { TestReport("fileattributesset",fileName,objPtr); - return Tcl_FSFileAttrsSet(interp, index, + return Tcl_FSFileAttrsSet(interp, index, TestReportGetNativePath(fileName), objPtr); } -static int +static int TestReportUtime (fileName, tval) Tcl_Obj* fileName; struct utimbuf *tval; @@ -6861,7 +6767,7 @@ TestReportNormalizePath(interp, pathPtr, nextCheckpoint) return nextCheckpoint; } -static int +static int SimplePathInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) { CONST char *str = Tcl_GetString(pathPtr); if (strncmp(str,"simplefs:/",10)) { @@ -6870,20 +6776,20 @@ SimplePathInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) { return TCL_OK; } -/* +/* * This is a slightly 'hacky' filesystem which is used just to test a * few important features of the vfs code: (1) that you can load a * shared library from a vfs, (2) that when copying files from one fs to * another, the 'mtime' is preserved. (3) that recursive * cross-filesystem directory copies have the correct behaviour * with/without -force. - * + * * It treats any file in 'simplefs:/' as a file, which it * routes to the current directory. The real file it uses is * whatever follows the trailing '/' (e.g. 'foo' in 'simplefs:/foo'), * and that file exists or not according to what is in the native * pwd. - * + * * Please do not consider this filesystem a model of how * things are to be done. It is quite the opposite! But, it * does allow us to test some important features. @@ -6897,7 +6803,7 @@ TestSimpleFilesystemObjCmd(dummy, interp, objc, objv) { int res, boolVal; char *msg; - + if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "boolean"); return TCL_ERROR; @@ -6916,7 +6822,7 @@ TestSimpleFilesystemObjCmd(dummy, interp, objc, objv) return res; } -/* +/* * Treats a file name 'simplefs:/foo' by using the file 'foo' * in the current (native) directory. */ @@ -6928,7 +6834,7 @@ SimpleRedirect(pathPtr) CONST char *str; Tcl_Obj *origPtr; - /* + /* * We assume the same name in the current directory is ok. */ str = Tcl_GetStringFromObj(pathPtr, &len); @@ -6936,7 +6842,7 @@ SimpleRedirect(pathPtr) /* Probably shouldn't ever reach here */ Tcl_IncrRefCount(pathPtr); return pathPtr; - } + } origPtr = Tcl_NewStringObj(str+10,-1); Tcl_IncrRefCount(origPtr); return origPtr; @@ -6960,8 +6866,8 @@ SimpleMatchInDirectory(interp, resultPtr, dirPtr, pattern, types) if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) { return TCL_OK; } - - /* + + /* * We assume the same name in the current directory is ok. */ resPtr = Tcl_NewObj(); @@ -6997,15 +6903,14 @@ SimpleOpenFileChannel(interp, pathPtr, mode, permissions) { Tcl_Obj *tempPtr; Tcl_Channel chan; - + if ((mode != 0) && !(mode & O_RDONLY)) { - Tcl_AppendResult(interp, "read-only", - (char *) NULL); + Tcl_AppendResult(interp, "read-only", NULL); return NULL; } - + tempPtr = SimpleRedirect(pathPtr); - + chan = Tcl_FSOpenFileChannel(interp, tempPtr, "r", permissions); Tcl_DecrRefCount(tempPtr); diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 51e91cf..1d4e689 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -1,19 +1,19 @@ -/* +/* * tclTestObj.c -- * - * This file contains C command procedures for the additional Tcl - * commands that are used for testing implementations of the Tcl object - * types. These commands are not normally included in Tcl - * applications; they're only used for testing. + * This file contains C command functions for the additional Tcl commands + * that are used for testing implementations of the Tcl object types. + * These commands are not normally included in Tcl applications; they're + * only used for testing. * * Copyright (c) 1995-1998 Sun Microsystems, Inc. * Copyright (c) 1999 by Scriptics Corporation. * Copyright (c) 2005 by Kevin B. Kenny. All rights reserved. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTestObj.c,v 1.15 2005/10/08 14:42:45 dgp Exp $ + * RCS: @(#) $Id: tclTestObj.c,v 1.16 2005/11/02 15:59:49 dkf Exp $ */ #include "tclInt.h" @@ -21,50 +21,42 @@ /* * An array of Tcl_Obj pointers used in the commands that operate on or get - * the values of Tcl object-valued variables. varPtr[i] is the i-th - * variable's Tcl_Obj *. + * the values of Tcl object-valued variables. varPtr[i] is the i-th variable's + * Tcl_Obj *. */ #define NUMBER_OF_OBJECT_VARS 20 static Tcl_Obj *varPtr[NUMBER_OF_OBJECT_VARS]; /* - * Forward declarations for procedures defined later in this file: + * Forward declarations for functions defined later in this file: */ -static int CheckIfVarUnset _ANSI_ARGS_((Tcl_Interp *interp, - int varIndex)); -static int GetVariableIndex _ANSI_ARGS_((Tcl_Interp *interp, - char *string, int *indexPtr)); -static void SetVarToObj _ANSI_ARGS_((int varIndex, - Tcl_Obj *objPtr)); -int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp)); -static int TestbignumobjCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TestbooleanobjCmd _ANSI_ARGS_((ClientData dummy, +static int CheckIfVarUnset(Tcl_Interp *interp, int varIndex); +static int GetVariableIndex(Tcl_Interp *interp, + char *string, int *indexPtr); +static void SetVarToObj(int varIndex, Tcl_Obj *objPtr); +int TclObjTest_Init(Tcl_Interp *interp); +static int TestbignumobjCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int TestbooleanobjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); + Tcl_Obj *CONST objv[]); #if 0 -static int TestconvertobjCmd _ANSI_ARGS_((ClientData dummy, +static int TestconvertobjCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); + Tcl_Obj *CONST objv[]); #endif -static int TestdoubleobjCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TestindexobjCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TestintobjCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TestobjCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int TeststringobjCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); +static int TestdoubleobjCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int TestindexobjCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int TestintobjCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int TestobjCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int TeststringobjCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); typedef struct TestString { int numChars; @@ -72,14 +64,13 @@ typedef struct TestString { size_t uallocated; Tcl_UniChar unicode[2]; } TestString; - /* *---------------------------------------------------------------------- * * TclObjTest_Init -- * - * This procedure creates additional commands that are used to test the + * This function creates additional commands that are used to test the * Tcl object support. * * Results: @@ -97,29 +88,28 @@ TclObjTest_Init(interp) Tcl_Interp *interp; { register int i; - + for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) { varPtr[i] = NULL; } - - Tcl_CreateObjCommand( interp, "testbignumobj", TestbignumobjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc*) NULL ); + + Tcl_CreateObjCommand(interp, "testbignumobj", TestbignumobjCmd, + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testbooleanobj", TestbooleanobjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); #if 0 Tcl_CreateObjCommand(interp, "testconvertobj", TestconvertobjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); #endif Tcl_CreateObjCommand(interp, "testdoubleobj", TestdoubleobjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testintobj", TestintobjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); + Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + (ClientData) 0, NULL); return TCL_OK; } @@ -128,7 +118,7 @@ TclObjTest_Init(interp) * * TestbignumobjCmd -- * - * This procedure implmenets the "testbignumobj" command. It is used + * This function implmenets the "testbignumobj" command. It is used * to exercise the bignum Tcl object type implementation. * * Results: @@ -149,8 +139,7 @@ TestbignumobjCmd( clientData, interp, objc, objv ) Tcl_Obj* CONST objv[]; /* Argument vector */ { const char * subcmds[] = { - "set", "get", "mult10", "div10", - NULL + "set", "get", "mult10", "div10", NULL }; enum options { BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10 @@ -193,12 +182,11 @@ TestbignumobjCmd( clientData, interp, objc, objv ) } /* - * If the object currently bound to the variable with index - * varIndex has ref count 1 (i.e. the object is unshared) we can - * modify that object directly. Otherwise, if RC>1 (i.e. the - * object is shared), we must create a new object to modify/set and - * decrement the old formerly-shared object's ref count. This is - * "copy on write". + * If the object currently bound to the variable with index varIndex + * has ref count 1 (i.e. the object is unshared) we can modify that + * object directly. Otherwise, if RC>1 (i.e. the object is shared), + * we must create a new object to modify/set and decrement the old + * formerly-shared object's ref count. This is "copy on write". */ if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { @@ -207,7 +195,7 @@ TestbignumobjCmd( clientData, interp, objc, objv ) SetVarToObj(varIndex, Tcl_NewBignumObj(&bignumValue)); } break; - + case BIGNUM_GET: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "varIndex"); @@ -230,7 +218,7 @@ TestbignumobjCmd( clientData, interp, objc, objv ) &bignumValue) != TCL_OK) { return TCL_ERROR; } - if (mp_init(&newValue) != MP_OKAY + if (mp_init(&newValue) != MP_OKAY || (mp_mul_d(&bignumValue, 10, &newValue) != MP_OKAY)) { mp_clear(&bignumValue); mp_clear(&newValue); @@ -258,7 +246,7 @@ TestbignumobjCmd( clientData, interp, objc, objv ) &bignumValue) != TCL_OK) { return TCL_ERROR; } - if (mp_init(&newValue) != MP_OKAY + if (mp_init(&newValue) != MP_OKAY || (mp_div_d(&bignumValue, 10, &newValue, NULL) != MP_OKAY)) { mp_clear(&bignumValue); mp_clear(&newValue); @@ -283,8 +271,8 @@ TestbignumobjCmd( clientData, interp, objc, objv ) * * TestbooleanobjCmd -- * - * This procedure implements the "testbooleanobj" command. It is used - * to test the boolean Tcl object type implementation. + * This function implements the "testbooleanobj" command. It is used to + * test the boolean Tcl object type implementation. * * Results: * A standard Tcl object result. @@ -368,7 +356,7 @@ TestbooleanobjCmd(clientData, interp, objc, objv) } else { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad option \"", Tcl_GetString(objv[1]), - "\": must be set, get, or not", (char *) NULL); + "\": must be set, get, or not", NULL); return TCL_ERROR; } return TCL_OK; @@ -380,8 +368,8 @@ TestbooleanobjCmd(clientData, interp, objc, objv) * * TestconvertobjCmd -- * - * This procedure implements the "testconvertobj" command. It is used - * to test converting objects to new types. + * This function implements the "testconvertobj" command. It is used to + * test converting objects to new types. * * Results: * A standard Tcl object result. @@ -423,7 +411,7 @@ TestconvertobjCmd(clientData, interp, objc, objv) } else { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad option \"", Tcl_GetString(objv[1]), - "\": must be double", (char *) NULL); + "\": must be double", NULL); return TCL_ERROR; } return TCL_OK; @@ -435,8 +423,8 @@ TestconvertobjCmd(clientData, interp, objc, objv) * * TestdoubleobjCmd -- * - * This procedure implements the "testdoubleobj" command. It is used - * to test the double-precision floating point Tcl object type + * This function implements the "testdoubleobj" command. It is used to + * test the double-precision floating point Tcl object type * implementation. * * Results: @@ -459,7 +447,7 @@ TestdoubleobjCmd(clientData, interp, objc, objv) int varIndex; double doubleValue; char *index, *subCmd, *string; - + if (objc < 3) { wrongNumArgs: Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?"); @@ -484,8 +472,8 @@ TestdoubleobjCmd(clientData, interp, objc, objv) /* * If the object currently bound to the variable with index varIndex * has ref count 1 (i.e. the object is unshared) we can modify that - * object directly. Otherwise, if RC>1 (i.e. the object is shared), - * we must create a new object to modify/set and decrement the old + * object directly. Otherwise, if RC>1 (i.e. the object is shared), we + * must create a new object to modify/set and decrement the old * formerly-shared object's ref count. This is "copy on write". */ @@ -540,7 +528,7 @@ TestdoubleobjCmd(clientData, interp, objc, objv) } else { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad option \"", Tcl_GetString(objv[1]), - "\": must be set, get, mult10, or div10", (char *) NULL); + "\": must be set, get, mult10, or div10", NULL); return TCL_ERROR; } return TCL_OK; @@ -551,7 +539,7 @@ TestdoubleobjCmd(clientData, interp, objc, objv) * * TestindexobjCmd -- * - * This procedure implements the "testindexobj" command. It is used to + * This function implements the "testindexobj" command. It is used to * test the index Tcl object type implementation. * * Results: @@ -573,7 +561,7 @@ TestindexobjCmd(clientData, interp, objc, objv) { int allowAbbrev, index, index2, setError, i, result; CONST char **argv; - static CONST char *tablePtr[] = {"a", "b", "check", (char *) NULL}; + static CONST char *tablePtr[] = {"a", "b", "check", NULL}; /* * Keep this structure declaration in sync with tclIndexObj.c */ @@ -587,20 +575,19 @@ TestindexobjCmd(clientData, interp, objc, objv) if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]), "check") == 0)) { /* - * This code checks to be sure that the results of - * Tcl_GetIndexFromObj are properly cached in the object and - * returned on subsequent lookups. + * This code checks to be sure that the results of Tcl_GetIndexFromObj + * are properly cached in the object and returned on subsequent + * lookups. */ if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) { return TCL_ERROR; } - Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1], tablePtr, - "token", 0, &index); + Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index); indexRep = (struct IndexRep *) objv[1]->internalRep.otherValuePtr; indexRep->index = index2; - result = Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1], + result = Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index); if (result == TCL_OK) { Tcl_SetIntObj(Tcl_GetObjResult(interp), index); @@ -625,12 +612,12 @@ TestindexobjCmd(clientData, interp, objc, objv) argv[i-4] = Tcl_GetString(objv[i]); } argv[objc-4] = NULL; - + /* - * Tcl_GetIndexFromObj assumes that the table is statically-allocated - * so that its address is different for each index object. If we - * accidently allocate a table at the same address as that cached in - * the index object, clear out the object's cached state. + * Tcl_GetIndexFromObj assumes that the table is statically-allocated so + * that its address is different for each index object. If we accidently + * allocate a table at the same address as that cached in the index + * object, clear out the object's cached state. */ if ( objv[3]->typePtr != NULL @@ -656,7 +643,7 @@ TestindexobjCmd(clientData, interp, objc, objv) * * TestintobjCmd -- * - * This procedure implements the "testintobj" command. It is used to + * This function implements the "testintobj" command. It is used to * test the int Tcl object type implementation. * * Results: @@ -679,7 +666,7 @@ TestintobjCmd(clientData, interp, objc, objv) int intValue, varIndex, i; long longValue; char *index, *subCmd, *string; - + if (objc < 3) { wrongNumArgs: Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?"); @@ -705,8 +692,8 @@ TestintobjCmd(clientData, interp, objc, objv) /* * If the object currently bound to the variable with index varIndex * has ref count 1 (i.e. the object is unshared) we can modify that - * object directly. Otherwise, if RC>1 (i.e. the object is shared), - * we must create a new object to modify/set and decrement the old + * object directly. Otherwise, if RC>1 (i.e. the object is shared), we + * must create a new object to modify/set and decrement the old * formerly-shared object's ref count. This is "copy on write". */ @@ -786,18 +773,18 @@ TestintobjCmd(clientData, interp, objc, objv) Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1); } else if (strcmp(subCmd, "inttoobigtest") == 0) { /* - * If long ints have more bits than ints on this platform, verify - * that Tcl_GetIntFromObj returns an error if the long int held - * in an integer object's internal representation is too large - * to fit in an int. + * If long ints have more bits than ints on this platform, verify that + * Tcl_GetIntFromObj returns an error if the long int held in an + * integer object's internal representation is too large to fit in an + * int. */ - + if (objc != 3) { goto wrongNumArgs; } #if (INT_MAX == LONG_MAX) /* int is same size as long int */ Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1); -#else +#else if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetLongObj(varPtr[varIndex], LONG_MAX); } else { @@ -847,8 +834,7 @@ TestintobjCmd(clientData, interp, objc, objv) } else { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad option \"", Tcl_GetString(objv[1]), - "\": must be set, get, get2, mult10, or div10", - (char *) NULL); + "\": must be set, get, get2, mult10, or div10", NULL); return TCL_ERROR; } return TCL_OK; @@ -859,7 +845,7 @@ TestintobjCmd(clientData, interp, objc, objv) * * TestobjCmd -- * - * This procedure implements the "testobj" command. It is used to test + * This function implements the "testobj" command. It is used to test * the type-independent portions of the Tcl object type implementation. * * Results: @@ -881,7 +867,7 @@ TestobjCmd(clientData, interp, objc, objv) int varIndex, destIndex, i; char *index, *subCmd, *string; Tcl_ObjType *targetType; - + if (objc < 2) { wrongNumArgs: Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?"); @@ -921,7 +907,7 @@ TestobjCmd(clientData, interp, objc, objv) typeName = Tcl_GetString(objv[3]); if ((targetType = Tcl_GetObjType(typeName)) == NULL) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "no type ", typeName, " found", (char *) NULL); + "no type ", typeName, " found", NULL); return TCL_ERROR; } if (Tcl_ConvertToType(interp, varPtr[varIndex], targetType) @@ -986,7 +972,7 @@ TestobjCmd(clientData, interp, objc, objv) * return an object containing the name of the argument's type * of internal rep. If none exists, return "none". */ - + if (objc != 3) { goto wrongNumArgs; } @@ -1038,11 +1024,9 @@ TestobjCmd(clientData, interp, objc, objv) } } else { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "bad option \"", - Tcl_GetString(objv[1]), + "bad option \"", Tcl_GetString(objv[1]), "\": must be assign, convert, duplicate, freeallvars, ", - "newobj, objcount, objtype, refcount, type, or types", - (char *) NULL); + "newobj, objcount, objtype, refcount, type, or types", NULL); return TCL_ERROR; } return TCL_OK; @@ -1053,7 +1037,7 @@ TestobjCmd(clientData, interp, objc, objv) * * TeststringobjCmd -- * - * This procedure implements the "teststringobj" command. It is used to + * This function implements the "teststringobj" command. It is used to * test the string Tcl object type implementation. * * Results: @@ -1079,8 +1063,7 @@ TeststringobjCmd(clientData, interp, objc, objv) TestString *strPtr; static CONST char *options[] = { "append", "appendstrings", "get", "get2", "length", "length2", - "set", "set2", "setlength", "ualloc", "getunicode", - (char *) NULL + "set", "set2", "setlength", "ualloc", "getunicode", NULL }; if (objc < 3) { @@ -1109,12 +1092,12 @@ TeststringobjCmd(clientData, interp, objc, objv) if (varPtr[varIndex] == NULL) { SetVarToObj(varIndex, Tcl_NewObj()); } - + /* * If the object bound to variable "varIndex" is shared, we must - * "copy on write" and append to a copy of the object. + * "copy on write" and append to a copy of the object. */ - + if (Tcl_IsShared(varPtr[varIndex])) { SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex])); } @@ -1132,7 +1115,7 @@ TeststringobjCmd(clientData, interp, objc, objv) /* * If the object bound to variable "varIndex" is shared, we must - * "copy on write" and append to a copy of the object. + * "copy on write" and append to a copy of the object. */ if (Tcl_IsShared(varPtr[varIndex])) { @@ -1196,13 +1179,13 @@ TeststringobjCmd(clientData, interp, objc, objv) /* * If the object currently bound to the variable with index - * varIndex has ref count 1 (i.e. the object is unshared) we - * can modify that object directly. Otherwise, if RC>1 (i.e. - * the object is shared), we must create a new object to - * modify/set and decrement the old formerly-shared object's - * ref count. This is "copy on write". + * varIndex has ref count 1 (i.e. the object is unshared) we can + * modify that object directly. Otherwise, if RC>1 (i.e. the + * object is shared), we must create a new object to modify/set + * and decrement the old formerly-shared object's ref count. This + * is "copy on write". */ - + string = Tcl_GetStringFromObj(objv[3], &length); if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { @@ -1265,9 +1248,9 @@ TeststringobjCmd(clientData, interp, objc, objv) * None. * * Side effects: - * This routine handles ref counting details for assignment: - * i.e. the old value's ref count must be decremented (if not NULL) and - * the new one incremented (also if not NULL). + * This routine handles ref counting details for assignment: i.e. the old + * value's ref count must be decremented (if not NULL) and the new one + * incremented (also if not NULL). * *---------------------------------------------------------------------- */ @@ -1311,7 +1294,7 @@ GetVariableIndex(interp, string, indexPtr) int *indexPtr; /* Place to store converted result. */ { int index; - + if (Tcl_GetInt(interp, string, &index) != TCL_OK) { return TCL_ERROR; } @@ -1330,7 +1313,7 @@ GetVariableIndex(interp, string, indexPtr) * * CheckIfVarUnset -- * - * Utility procedure that checks whether a test variable is readable: + * Utility function that checks whether a test variable is readable: * i.e., that varPtr[varIndex] is non-NULL. * * Results: @@ -1350,7 +1333,7 @@ CheckIfVarUnset(interp, varIndex) { if (varPtr[varIndex] == NULL) { char buf[32 + TCL_INTEGER_SPACE]; - + sprintf(buf, "variable %d is unset (NULL)", varIndex); Tcl_ResetResult(interp); Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1); @@ -1358,3 +1341,11 @@ CheckIfVarUnset(interp, varIndex) } return 0; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c index 5d8084d..e3f12a1 100644 --- a/generic/tclTestProcBodyObj.c +++ b/generic/tclTestProcBodyObj.c @@ -1,16 +1,16 @@ -/* +/* * tclTestProcBodyObj.c -- * - * Implements the "procbodytest" package, which contains commands - * to test creation of Tcl procedures whose body argument is a - * Tcl_Obj of type "procbody" rather than a string. + * Implements the "procbodytest" package, which contains commands to test + * creation of Tcl procedures whose body argument is a Tcl_Obj of type + * "procbody" rather than a string. * * 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. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTestProcBodyObj.c,v 1.3 2004/08/25 01:11:20 dgp Exp $ + * RCS: @(#) $Id: tclTestProcBodyObj.c,v 1.4 2005/11/02 15:59:49 dkf Exp $ */ #include "tclInt.h" @@ -44,31 +44,26 @@ typedef struct CmdTable * Declarations for functions defined in this file. */ -static int ProcBodyTestProcObjCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); -static int ProcBodyTestInitInternal _ANSI_ARGS_((Tcl_Interp *interp, - int isSafe)); -static int RegisterCommand _ANSI_ARGS_((Tcl_Interp* interp, - char *namespace, CONST CmdTable *cmdTablePtr)); -int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp * interp)); -int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp * interp)); +static int ProcBodyTestProcObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); +static int ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe); +static int RegisterCommand(Tcl_Interp* interp, + char *namespace, CONST CmdTable *cmdTablePtr); +int Procbodytest_Init(Tcl_Interp * interp); +int Procbodytest_SafeInit(Tcl_Interp * interp); /* * List of commands to create when the package is loaded; must go after the * declarations of the enable command procedure. */ -static CONST CmdTable commands[] = -{ +static CONST CmdTable commands[] = { { procCommand, ProcBodyTestProcObjCmd, 1 }, - { 0, 0, 0 } }; -static CONST CmdTable safeCommands[] = -{ +static CONST CmdTable safeCommands[] = { { procCommand, ProcBodyTestProcObjCmd, 1 }, - { 0, 0, 0 } }; @@ -77,7 +72,7 @@ static CONST CmdTable safeCommands[] = * * Procbodytest_Init -- * - * This procedure initializes the "procbodytest" package. + * This function initializes the "procbodytest" package. * * Results: * A standard Tcl result. @@ -101,7 +96,7 @@ Procbodytest_Init(interp) * * Procbodytest_SafeInit -- * - * This procedure initializes the "procbodytest" package. + * This function initializes the "procbodytest" package. * * Results: * A standard Tcl result. @@ -125,7 +120,7 @@ Procbodytest_SafeInit(interp) * * RegisterCommand -- * - * This procedure registers a command in the context of the given namespace. + * This function registers a command in the context of the given namespace. * * Results: * A standard Tcl result. @@ -137,11 +132,11 @@ Procbodytest_SafeInit(interp) */ static int RegisterCommand(interp, namespace, cmdTablePtr) - Tcl_Interp* interp; /* the Tcl interpreter for which the - * operation is performed */ - char *namespace; /* the namespace in which the command - * is registered */ - CONST CmdTable *cmdTablePtr; /* the command to register */ + Tcl_Interp* interp; /* the Tcl interpreter for which the operation + * is performed */ + char *namespace; /* the namespace in which the command is + * registered */ + CONST CmdTable *cmdTablePtr;/* the command to register */ { char buf[128]; @@ -151,7 +146,7 @@ static int RegisterCommand(interp, namespace, cmdTablePtr) if (Tcl_Eval(interp, buf) != TCL_OK) return TCL_ERROR; } - + sprintf(buf, "%s::%s", namespace, cmdTablePtr->cmdName); Tcl_CreateObjCommand(interp, buf, cmdTablePtr->proc, 0, 0); @@ -163,7 +158,7 @@ static int RegisterCommand(interp, namespace, cmdTablePtr) * * ProcBodyTestInitInternal -- * - * This procedure initializes the Loader package. + * This function initializes the Loader package. * The isSafe flag is 1 if the interpreter is safe, 0 otherwise. * * Results: @@ -189,7 +184,7 @@ ProcBodyTestInitInternal(interp, isSafe) return TCL_ERROR; } } - + return Tcl_PkgProvide(interp, packageName, packageVersion); } @@ -236,11 +231,11 @@ ProcBodyTestProcObjCmd (dummy, interp, objc, objv) char *fullName; Tcl_Command procCmd; Command *cmdPtr; - Proc *procPtr = (Proc *) NULL; + Proc *procPtr = NULL; Tcl_Obj *bodyObjPtr; Tcl_Obj *myobjv[5]; int result; - + if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "newName argsList bodyName"); return TCL_ERROR; @@ -249,10 +244,9 @@ ProcBodyTestProcObjCmd (dummy, interp, objc, objv) /* * Find the Command pointer to this procedure */ - - fullName = Tcl_GetStringFromObj(objv[3], (int *) NULL); - procCmd = Tcl_FindCommand(interp, fullName, (Tcl_Namespace *) NULL, - TCL_LEAVE_ERR_MSG); + + fullName = Tcl_GetStringFromObj(objv[3], NULL); + procCmd = Tcl_FindCommand(interp, fullName, NULL, TCL_LEAVE_ERR_MSG); if (procCmd == NULL) { return TCL_ERROR; } @@ -266,23 +260,22 @@ ProcBodyTestProcObjCmd (dummy, interp, objc, objv) if (cmdPtr->objProc != TclGetObjInterpProc()) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "command \"", fullName, - "\" is not a Tcl procedure", (char *) NULL); + "command \"", fullName, "\" is not a Tcl procedure", NULL); return TCL_ERROR; } /* * it is a Tcl procedure: the client data is the Proc structure */ - + procPtr = (Proc *) cmdPtr->objClientData; if (procPtr == NULL) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "procedure \"", fullName, - "\" does not have a Proc struct!", (char *) NULL); + "\" does not have a Proc struct!", NULL); return TCL_ERROR; } - + /* * create a new object, initialize our argument vector, call into Tcl */ @@ -291,7 +284,7 @@ ProcBodyTestProcObjCmd (dummy, interp, objc, objv) if (bodyObjPtr == NULL) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "failed to create a procbody object for procedure \"", - fullName, "\"", (char *) NULL); + fullName, "\"", NULL); return TCL_ERROR; } Tcl_IncrRefCount(bodyObjPtr); @@ -300,10 +293,18 @@ ProcBodyTestProcObjCmd (dummy, interp, objc, objv) myobjv[1] = objv[1]; myobjv[2] = objv[2]; myobjv[3] = bodyObjPtr; - myobjv[4] = (Tcl_Obj *) NULL; + myobjv[4] = NULL; result = Tcl_ProcObjCmd((ClientData) NULL, interp, objc, myobjv); Tcl_DecrRefCount(bodyObjPtr); return result; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index 50dd8c9..3bb8c96 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -1,4 +1,4 @@ -/* +/* * tclThreadTest.c -- * * This file implements the testthread command. Eventually this @@ -11,23 +11,23 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclThreadTest.c,v 1.22 2005/10/08 14:42:45 dgp Exp $ + * RCS: @(#) $Id: tclThreadTest.c,v 1.23 2005/11/02 15:59:49 dkf Exp $ */ #include "tclInt.h" -extern int Tcltest_Init( Tcl_Interp* ); +extern int Tcltest_Init(Tcl_Interp *interp); #ifdef TCL_THREADS /* - * Each thread has an single instance of the following structure. There - * is one instance of this structure per thread even if that thread contains - * multiple interpreters. The interpreter identified by this structure is - * the main interpreter for the thread. - * - * The main interpreter is the one that will process any messages - * received by a thread. Any thread can send messages but only the - * main interpreter can receive them. + * Each thread has an single instance of the following structure. There is one + * instance of this structure per thread even if that thread contains multiple + * interpreters. The interpreter identified by this structure is the main + * interpreter for the thread. + * + * The main interpreter is the one that will process any messages received by + * a thread. Any thread can send messages but only the main interpreter can + * receive them. */ typedef struct ThreadSpecificData { @@ -40,8 +40,8 @@ typedef struct ThreadSpecificData { static Tcl_ThreadDataKey dataKey; /* - * This list is used to list all threads that have interpreters. - * This is protected by threadMutex. + * This list is used to list all threads that have interpreters. This is + * protected by threadMutex. */ static struct ThreadSpecificData *threadList; @@ -59,16 +59,18 @@ static struct ThreadSpecificData *threadList; */ typedef struct ThreadCtrl { - char *script; /* The TCL command this thread should execute */ - int flags; /* Initial value of the "flags" field in the - * ThreadSpecificData structure for the new thread. - * Might contain TP_Detached or TP_TclThread. */ - Tcl_Condition condWait; - /* This condition variable is used to synchronize - * the parent and child threads. The child won't run - * until it acquires threadMutex, and the parent function - * won't complete until signaled on this condition - * variable. */ + char *script; /* The Tcl command this thread should + * execute */ + int flags; /* Initial value of the "flags" field in the + * ThreadSpecificData structure for the new + * thread. Might contain TP_Detached or + * TP_TclThread. */ + Tcl_Condition condWait; /* This condition variable is used to + * synchronize the parent and child threads. + * The child won't run until it acquires + * threadMutex, and the parent function won't + * complete until signaled on this condition + * variable. */ } ThreadCtrl; /* @@ -79,8 +81,8 @@ typedef struct ThreadEvent { Tcl_Event event; /* Must be first */ char *script; /* The script to execute. */ struct ThreadEventResult *resultPtr; - /* To communicate the result. This is - * NULL if we don't care about it. */ + /* To communicate the result. This is NULL if + * we don't care about it. */ } ThreadEvent; typedef struct ThreadEventResult { @@ -106,9 +108,9 @@ static ThreadEventResult *resultList; static Tcl_ThreadId errorThreadId; static char *errorProcString; -/* - * Access to the list of threads and to the thread send results is - * guarded by this mutex. +/* + * Access to the list of threads and to the thread send results is guarded by + * this mutex. */ TCL_DECLARE_MUTEX(threadMutex) @@ -116,34 +118,28 @@ TCL_DECLARE_MUTEX(threadMutex) #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLEXPORT -EXTERN int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp)); -EXTERN int Tcl_ThreadObjCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); -EXTERN int TclCreateThread _ANSI_ARGS_((Tcl_Interp *interp, - char *script, int joinable)); -EXTERN int TclThreadList _ANSI_ARGS_((Tcl_Interp *interp)); -EXTERN int TclThreadSend _ANSI_ARGS_((Tcl_Interp *interp, Tcl_ThreadId id, - char *script, int wait)); +EXTERN int TclThread_Init(Tcl_Interp *interp); +EXTERN int Tcl_ThreadObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]); +EXTERN int TclCreateThread(Tcl_Interp *interp, char *script, + int joinable); +EXTERN int TclThreadList(Tcl_Interp *interp); +EXTERN int TclThreadSend(Tcl_Interp *interp, Tcl_ThreadId id, + char *script, int wait); #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -Tcl_ThreadCreateType NewTestThread _ANSI_ARGS_((ClientData clientData)); -static void ListRemove _ANSI_ARGS_((ThreadSpecificData *tsdPtr)); -static void ListUpdateInner _ANSI_ARGS_((ThreadSpecificData *tsdPtr)); -static int ThreadEventProc _ANSI_ARGS_((Tcl_Event *evPtr, int mask)); -static void ThreadErrorProc _ANSI_ARGS_((Tcl_Interp *interp)); -static void ThreadFreeProc _ANSI_ARGS_((ClientData clientData)); -static int ThreadDeleteEvent _ANSI_ARGS_((Tcl_Event *eventPtr, - ClientData clientData)); -static void ThreadExitProc _ANSI_ARGS_((ClientData clientData)); - - -/* Forward declaration of function import from "tclTest.c". - */ - -int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp)); - +Tcl_ThreadCreateType NewTestThread(ClientData clientData); +static void ListRemove(ThreadSpecificData *tsdPtr); +static void ListUpdateInner(ThreadSpecificData *tsdPtr); +static int ThreadEventProc(Tcl_Event *evPtr, int mask); +static void ThreadErrorProc(Tcl_Interp *interp); +static void ThreadFreeProc(ClientData clientData); +static int ThreadDeleteEvent(Tcl_Event *eventPtr, + ClientData clientData); +static void ThreadExitProc(ClientData clientData); /* *---------------------------------------------------------------------- @@ -162,12 +158,12 @@ int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp)); */ int -TclThread_Init(interp) - Tcl_Interp *interp; /* The current Tcl interpreter */ +TclThread_Init( + Tcl_Interp *interp) /* The current Tcl interpreter */ { - - Tcl_CreateObjCommand(interp,"testthread", Tcl_ThreadObjCmd, - (ClientData)NULL ,NULL); + + Tcl_CreateObjCommand(interp,"testthread", Tcl_ThreadObjCmd, + (ClientData) NULL, NULL); return TCL_OK; } @@ -200,19 +196,22 @@ TclThread_Init(interp) /* ARGSUSED */ int -Tcl_ThreadObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +Tcl_ThreadObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); int option; - static CONST char *threadOptions[] = {"create", "exit", "id", "join", "names", - "send", "wait", "errorproc", - (char *) NULL}; - enum options {THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_JOIN, - THREAD_NAMES, THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC}; + static CONST char *threadOptions[] = { + "create", "exit", "id", "join", "names", + "send", "wait", "errorproc", NULL + }; + enum options { + THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_JOIN, + THREAD_NAMES, THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC + }; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?args?"); @@ -223,7 +222,7 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } - /* + /* * Make sure the initial thread is on the list before doing anything. */ @@ -236,158 +235,159 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv) } switch ((enum options)option) { - case THREAD_CREATE: { - char *script; - int joinable, len; + case THREAD_CREATE: { + char *script; + int joinable, len; - if (objc == 2) { - /* Neither joinable nor special script - */ + if (objc == 2) { + /* + * Neither joinable nor special script + */ - joinable = 0; - script = "testthread wait"; /* Just enter the event loop */ + joinable = 0; + script = "testthread wait"; /* Just enter event loop */ - } else if (objc == 3) { - /* Possibly -joinable, then no special script, - * no joinable, then its a script. - */ + } else if (objc == 3) { + /* + * Possibly -joinable, then no special script, no joinable, then + * its a script. + */ - script = Tcl_GetString(objv[2]); - len = strlen (script); + script = Tcl_GetStringFromObj(objv[2], &len); - if ((len > 1) && + if ((len > 1) && (script [0] == '-') && (script [1] == 'j') && (0 == strncmp (script, "-joinable", (size_t) len))) { - joinable = 1; - script = "testthread wait"; /* Just enter the event loop - */ - } else { - /* Remember the script */ - joinable = 0; - } - } else if (objc == 4) { - /* Definitely a script available, but is the flag - * -joinable ? + joinable = 1; + script = "testthread wait"; /* Just enter event loop */ + } else { + /* + * Remember the script */ - script = Tcl_GetString(objv[2]); - len = strlen (script); + joinable = 0; + } + } else if (objc == 4) { + /* + * Definitely a script available, but is the flag -joinable? + */ - joinable = ((len > 1) && - (script [0] == '-') && (script [1] == 'j') && - (0 == strncmp (script, "-joinable", (size_t) len))); + script = Tcl_GetStringFromObj(objv[2], &len); - script = Tcl_GetString(objv[3]); - } else { - Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?"); - return TCL_ERROR; - } - return TclCreateThread(interp, script, joinable); + joinable = ((len > 1) && + (script [0] == '-') && (script [1] == 'j') && + (0 == strncmp(script, "-joinable", (size_t) len))); + + script = Tcl_GetString(objv[3]); + } else { + Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?"); + return TCL_ERROR; } - case THREAD_EXIT: { - if (objc > 2) { - Tcl_WrongNumArgs(interp, 1, objv, NULL); - return TCL_ERROR; - } - ListRemove(NULL); - Tcl_ExitThread(0); - return TCL_OK; + return TclCreateThread(interp, script, joinable); + } + case THREAD_EXIT: + if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; } - case THREAD_ID: - if (objc == 2) { - Tcl_Obj *idObj = Tcl_NewLongObj((long)Tcl_GetCurrentThread()); - Tcl_SetObjResult(interp, idObj); - return TCL_OK; - } else { - Tcl_WrongNumArgs(interp, 2, objv, NULL); - return TCL_ERROR; - } - case THREAD_JOIN: { - long id; - int result, status; + ListRemove(NULL); + Tcl_ExitThread(0); + return TCL_OK; + case THREAD_ID: + if (objc == 2) { + Tcl_Obj *idObj = Tcl_NewLongObj((long) Tcl_GetCurrentThread()); - if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "join id"); - return TCL_ERROR; - } - if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) { - return TCL_ERROR; - } + Tcl_SetObjResult(interp, idObj); + return TCL_OK; + } else { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + return TCL_ERROR; + } + case THREAD_JOIN: { + long id; + int result, status; - result = Tcl_JoinThread ((Tcl_ThreadId) id, &status); - if (result == TCL_OK) { - Tcl_SetIntObj (Tcl_GetObjResult (interp), status); - } else { - char buf [20]; - sprintf (buf, "%ld", id); - Tcl_AppendResult (interp, "cannot join thread ", buf, NULL); - } - return result; + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "join id"); + return TCL_ERROR; } - case THREAD_NAMES: { - if (objc > 2) { - Tcl_WrongNumArgs(interp, 2, objv, NULL); - return TCL_ERROR; - } - return TclThreadList(interp); + if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) { + return TCL_ERROR; } - case THREAD_SEND: { - long id; - char *script; - int wait, arg; - if ((objc != 4) && (objc != 5)) { + result = Tcl_JoinThread ((Tcl_ThreadId) id, &status); + if (result == TCL_OK) { + Tcl_SetIntObj (Tcl_GetObjResult (interp), status); + } else { + char buf [20]; + + sprintf(buf, "%ld", id); + Tcl_AppendResult(interp, "cannot join thread ", buf, NULL); + } + return result; + } + case THREAD_NAMES: + if (objc > 2) { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + return TCL_ERROR; + } + return TclThreadList(interp); + case THREAD_SEND: { + long id; + char *script; + int wait, arg; + + if ((objc != 4) && (objc != 5)) { + Tcl_WrongNumArgs(interp, 1, objv, "send ?-async? id script"); + return TCL_ERROR; + } + if (objc == 5) { + if (strcmp("-async", Tcl_GetString(objv[2])) != 0) { Tcl_WrongNumArgs(interp, 1, objv, "send ?-async? id script"); return TCL_ERROR; } - if (objc == 5) { - if (strcmp("-async", Tcl_GetString(objv[2])) != 0) { - Tcl_WrongNumArgs(interp, 1, objv, "send ?-async? id script"); - return TCL_ERROR; - } - wait = 0; - arg = 3; - } else { - wait = 1; - arg = 2; - } - if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) { - return TCL_ERROR; - } - arg++; - script = Tcl_GetString(objv[arg]); - return TclThreadSend(interp, (Tcl_ThreadId) id, script, wait); + wait = 0; + arg = 3; + } else { + wait = 1; + arg = 2; } - case THREAD_WAIT: { - while (1) { - (void) Tcl_DoOneEvent(TCL_ALL_EVENTS); - } + if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) { + return TCL_ERROR; } - case THREAD_ERRORPROC: { - /* - * Arrange for this proc to handle thread death errors. - */ + arg++; + script = Tcl_GetString(objv[arg]); + return TclThreadSend(interp, (Tcl_ThreadId) id, script, wait); + } + case THREAD_ERRORPROC: { + /* + * Arrange for this proc to handle thread death errors. + */ - char *proc; - if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "errorproc proc"); - return TCL_ERROR; - } - Tcl_MutexLock(&threadMutex); - errorThreadId = Tcl_GetCurrentThread(); - if (errorProcString) { - ckfree(errorProcString); - } - proc = Tcl_GetString(objv[2]); - errorProcString = ckalloc(strlen(proc)+1); - strcpy(errorProcString, proc); - Tcl_MutexUnlock(&threadMutex); - return TCL_OK; + char *proc; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "errorproc proc"); + return TCL_ERROR; + } + Tcl_MutexLock(&threadMutex); + errorThreadId = Tcl_GetCurrentThread(); + if (errorProcString) { + ckfree(errorProcString); + } + proc = Tcl_GetString(objv[2]); + errorProcString = ckalloc(strlen(proc)+1); + strcpy(errorProcString, proc); + Tcl_MutexUnlock(&threadMutex); + return TCL_OK; + } + case THREAD_WAIT: + while (1) { + (void) Tcl_DoOneEvent(TCL_ALL_EVENTS); } } return TCL_OK; } - /* *---------------------------------------------------------------------- @@ -395,7 +395,7 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv) * TclCreateThread -- * * This procedure is invoked to create a thread containing an interp to - * run a script. This returns after the thread has started executing. + * run a script. This returns after the thread has started executing. * * Results: * A standard Tcl result, which is the thread ID. @@ -408,10 +408,10 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -TclCreateThread(interp, script, joinable) - Tcl_Interp *interp; /* Current interpreter. */ - char *script; /* Script to execute */ - int joinable; /* Flag, joinable thread or not */ +TclCreateThread( + Tcl_Interp *interp, /* Current interpreter. */ + char *script, /* Script to execute */ + int joinable) /* Flag, joinable thread or not */ { ThreadCtrl ctrl; Tcl_ThreadId id; @@ -447,32 +447,32 @@ TclCreateThread(interp, script, joinable) * * NewTestThread -- * - * This routine is the "main()" for a new thread whose task is to - * execute a single TCL script. The argument to this function is - * a pointer to a structure that contains the text of the TCL script - * to be executed. - * - * Space to hold the script field of the ThreadControl structure passed - * in as the only argument was obtained from malloc() and must be freed - * by this function before it exits. Space to hold the ThreadControl - * structure itself is released by the calling function, and the - * two condition variables in the ThreadControl structure are destroyed - * by the calling function. The calling function will destroy the - * ThreadControl structure and the condition variable as soon as - * ctrlPtr->condWait is signaled, so this routine must make copies of - * any data it might need after that point. + * This routine is the "main()" for a new thread whose task is to execute + * a single Tcl script. The argument to this function is a pointer to a + * structure that contains the text of the TCL script to be executed. + * + * Space to hold the script field of the ThreadControl structure passed + * in as the only argument was obtained from malloc() and must be freed + * by this function before it exits. Space to hold the ThreadControl + * structure itself is released by the calling function, and the two + * condition variables in the ThreadControl structure are destroyed by + * the calling function. The calling function will destroy the + * ThreadControl structure and the condition variable as soon as + * ctrlPtr->condWait is signaled, so this routine must make copies of any + * data it might need after that point. * * Results: - * none + * None * * Side effects: - * A TCL script is executed in a new thread. + * A Tcl script is executed in a new thread. * *------------------------------------------------------------------------ */ + Tcl_ThreadCreateType -NewTestThread(clientData) - ClientData clientData; +NewTestThread( + ClientData clientData) { ThreadCtrl *ctrlPtr = (ThreadCtrl*)clientData; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -487,10 +487,11 @@ NewTestThread(clientData) result = Tcl_Init(tsdPtr->interp); result = TclThread_Init(tsdPtr->interp); - /* This is part of the test facility. - * Initialize _ALL_ test commands for + /* + * This is part of the test facility. Initialize _ALL_ test commands for * use by the new thread. */ + result = Tcltest_Init(tsdPtr->interp); /* @@ -499,10 +500,12 @@ NewTestThread(clientData) Tcl_MutexLock(&threadMutex); ListUpdateInner(tsdPtr); + /* - * We need to keep a pointer to the alloc'ed mem of the script - * we are eval'ing, for the case that we exit during evaluation + * We need to keep a pointer to the alloc'ed mem of the script we are + * eval'ing, for the case that we exit during evaluation */ + threadEvalScript = (char *) ckalloc(strlen(ctrlPtr->script)+1); strcpy(threadEvalScript, ctrlPtr->script); @@ -542,19 +545,20 @@ NewTestThread(clientData) * * ThreadErrorProc -- * - * Send a message to the thread willing to hear about errors. + * Send a message to the thread willing to hear about errors. * * Results: - * none + * None * * Side effects: - * Send an event. + * Send an event. * *------------------------------------------------------------------------ */ + static void -ThreadErrorProc(interp) - Tcl_Interp *interp; /* Interp that failed */ +ThreadErrorProc( + Tcl_Interp *interp) /* Interp that failed */ { Tcl_Channel errChannel; CONST char *errorInfo, *argv[3]; @@ -586,20 +590,21 @@ ThreadErrorProc(interp) * * ListUpdateInner -- * - * Add the thread local storage to the list. This assumes - * the caller has obtained the mutex. + * Add the thread local storage to the list. This assumes the caller has + * obtained the mutex. * * Results: - * none + * None * * Side effects: - * Add the thread local storage to its list. + * Add the thread local storage to its list. * *------------------------------------------------------------------------ */ + static void -ListUpdateInner(tsdPtr) - ThreadSpecificData *tsdPtr; +ListUpdateInner( + ThreadSpecificData *tsdPtr) { if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); @@ -618,20 +623,21 @@ ListUpdateInner(tsdPtr) * * ListRemove -- * - * Remove the thread local storage from its list. This grabs the - * mutex to protect the list. + * Remove the thread local storage from its list. This grabs the mutex to + * protect the list. * * Results: - * none + * None * * Side effects: - * Remove the thread local storage from its list. + * Remove the thread local storage from its list. * *------------------------------------------------------------------------ */ + static void -ListRemove(tsdPtr) - ThreadSpecificData *tsdPtr; +ListRemove( + ThreadSpecificData *tsdPtr) { if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); @@ -648,7 +654,6 @@ ListRemove(tsdPtr) tsdPtr->nextPtr = tsdPtr->prevPtr = 0; Tcl_MutexUnlock(&threadMutex); } - /* *------------------------------------------------------------------------ @@ -666,8 +671,8 @@ ListRemove(tsdPtr) *------------------------------------------------------------------------ */ int -TclThreadList(interp) - Tcl_Interp *interp; +TclThreadList( + Tcl_Interp *interp) { ThreadSpecificData *tsdPtr; Tcl_Obj *listPtr; @@ -682,7 +687,6 @@ TclThreadList(interp) Tcl_SetObjResult(interp, listPtr); return TCL_OK; } - /* *------------------------------------------------------------------------ @@ -699,12 +703,13 @@ TclThreadList(interp) * *------------------------------------------------------------------------ */ + int -TclThreadSend(interp, id, script, wait) - Tcl_Interp *interp; /* The current interpreter. */ - Tcl_ThreadId id; /* Thread Id of other interpreter. */ - char *script; /* The script to evaluate. */ - int wait; /* If 1, we block for the result. */ +TclThreadSend( + Tcl_Interp *interp, /* The current interpreter. */ + Tcl_ThreadId id, /* Thread Id of other interpreter. */ + char *script, /* The script to evaluate. */ + int wait) /* If 1, we block for the result. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); ThreadEvent *threadEventPtr; @@ -712,7 +717,7 @@ TclThreadSend(interp, id, script, wait) int found, code; Tcl_ThreadId threadId = (Tcl_ThreadId) id; - /* + /* * Verify the thread exists. */ @@ -731,8 +736,8 @@ TclThreadSend(interp, id, script, wait) } /* - * Short circut sends to ourself. Ought to do something with -async, - * like run in an idle handler. + * Short circut sends to ourself. Ought to do something with -async, like + * run in an idle handler. */ if (threadId == Tcl_GetCurrentThread()) { @@ -740,7 +745,7 @@ TclThreadSend(interp, id, script, wait) return Tcl_GlobalEval(interp, script); } - /* + /* * Create the event for its event queue. */ @@ -763,7 +768,7 @@ TclThreadSend(interp, id, script, wait) resultPtr->errorInfo = NULL; resultPtr->errorCode = NULL; - /* + /* * Maintain the cleanup list. */ @@ -783,7 +788,7 @@ TclThreadSend(interp, id, script, wait) */ threadEventPtr->event.proc = ThreadEventProc; - Tcl_ThreadQueueEvent(threadId, (Tcl_Event *)threadEventPtr, + Tcl_ThreadQueueEvent(threadId, (Tcl_Event *)threadEventPtr, TCL_QUEUE_TAIL); Tcl_ThreadAlert(threadId); @@ -792,7 +797,7 @@ TclThreadSend(interp, id, script, wait) return TCL_OK; } - /* + /* * Block on the results and then get them. */ @@ -837,7 +842,6 @@ TclThreadSend(interp, id, script, wait) return code; } - /* *------------------------------------------------------------------------ @@ -854,10 +858,11 @@ TclThreadSend(interp, id, script, wait) * *------------------------------------------------------------------------ */ + static int -ThreadEventProc(evPtr, mask) - Tcl_Event *evPtr; /* Really ThreadEvent */ - int mask; +ThreadEventProc( + Tcl_Event *evPtr, /* Really ThreadEvent */ + int mask) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); ThreadEvent *threadEventPtr = (ThreadEvent *)evPtr; @@ -926,10 +931,11 @@ ThreadEventProc(evPtr, mask) * *------------------------------------------------------------------------ */ + /* ARGSUSED */ static void -ThreadFreeProc(clientData) - ClientData clientData; +ThreadFreeProc( + ClientData clientData) { if (clientData) { ckfree((char *) clientData); @@ -952,20 +958,23 @@ ThreadFreeProc(clientData) * *------------------------------------------------------------------------ */ + /* ARGSUSED */ static int -ThreadDeleteEvent(eventPtr, clientData) - Tcl_Event *eventPtr; /* Really ThreadEvent */ - ClientData clientData; /* dummy */ +ThreadDeleteEvent( + Tcl_Event *eventPtr, /* Really ThreadEvent */ + ClientData clientData) /* dummy */ { if (eventPtr->proc == ThreadEventProc) { ckfree((char *) ((ThreadEvent *) eventPtr)->script); return 1; } + /* - * If it was NULL, we were in the middle of servicing the event - * and it should be removed + * If it was NULL, we were in the middle of servicing the event and it + * should be removed */ + return (eventPtr->proc == NULL); } @@ -974,21 +983,22 @@ ThreadDeleteEvent(eventPtr, clientData) * * ThreadExitProc -- * - * This is called when the thread exits. + * This is called when the thread exits. * * Results: * None. * * Side effects: - * It unblocks anyone that is waiting on a send to this thread. - * It cleans up any events in the event queue for this thread. + * It unblocks anyone that is waiting on a send to this thread. It cleans + * up any events in the event queue for this thread. * *------------------------------------------------------------------------ */ + /* ARGSUSED */ static void -ThreadExitProc(clientData) - ClientData clientData; +ThreadExitProc( + ClientData clientData) { char *threadEvalScript = (char *) clientData; ThreadEventResult *resultPtr, *nextPtr; @@ -1006,9 +1016,10 @@ ThreadExitProc(clientData) nextPtr = resultPtr->nextPtr; if (resultPtr->srcThreadId == self) { /* - * We are going away. By freeing up the result we signal - * to the other thread we don't care about the result. + * We are going away. By freeing up the result we signal to the + * other thread we don't care about the result. */ + if (resultPtr->prevPtr) { resultPtr->prevPtr->nextPtr = resultPtr->nextPtr; } else { @@ -1022,9 +1033,9 @@ ThreadExitProc(clientData) ckfree((char *)resultPtr); } else if (resultPtr->dstThreadId == self) { /* - * Dang. The target is going away. Unblock the caller. - * The result string must be dynamically allocated because - * the main thread is going to call free on it. + * Dang. The target is going away. Unblock the caller. The result + * string must be dynamically allocated because the main thread is + * going to call free on it. */ char *msg = "target thread died"; @@ -1036,5 +1047,12 @@ ThreadExitProc(clientData) } Tcl_MutexUnlock(&threadMutex); } - #endif /* TCL_THREADS */ + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |