diff options
Diffstat (limited to 'generic/tclTest.c')
| -rw-r--r-- | generic/tclTest.c | 2109 |
1 files changed, 1220 insertions, 889 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index 7b6cdea..1d92ff5 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -15,12 +15,9 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#undef STATIC_BUILD -#ifndef USE_TCL_STUBS -# define USE_TCL_STUBS -#endif +#define TCL_TEST #include "tclInt.h" -#include "tclOO.h" + #include <math.h> /* @@ -43,17 +40,6 @@ */ /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Tcltest_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ - -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT -EXTERN int Tcltest_Init(Tcl_Interp *interp); -EXTERN int Tcltest_SafeInit(Tcl_Interp *interp); - -/* * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect * the results of the various deletion callbacks. */ @@ -75,7 +61,7 @@ typedef struct TestAsyncHandler { /* Next is list of handlers. */ } TestAsyncHandler; -TCL_DECLARE_MUTEX(asyncTestMutex) +TCL_DECLARE_MUTEX(asyncTestMutex); static TestAsyncHandler *firstHandler = NULL; @@ -155,6 +141,7 @@ static TestChannel *firstDetached; * Forward declarations for procedures defined later in this file: */ +int Tcltest_Init(Tcl_Interp *interp); static int AsyncHandlerProc(ClientData clientData, Tcl_Interp *interp, int code); #ifdef TCL_THREADS @@ -165,334 +152,338 @@ static void CleanupTestSetassocdataTests( static void CmdDelProc1(ClientData clientData); static void CmdDelProc2(ClientData clientData); static int CmdProc1(ClientData clientData, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int CmdProc2(ClientData clientData, - Tcl_Interp *interp, size_t argc, - const char **argv); + 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, size_t argc, - const char *argv[]); + ClientData cmdClientData, int argc, + char **argv); static void CmdTraceProc(ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *cmdProc, ClientData cmdClientData, - size_t argc, const char *argv[]); + int argc, char **argv); static int CreatedCommandProc( ClientData clientData, Tcl_Interp *interp, - size_t argc, const char **argv); + int argc, const char **argv); static int CreatedCommandProc2( ClientData clientData, Tcl_Interp *interp, - size_t argc, const char **argv); + int argc, const char **argv); static void DelCallbackProc(ClientData clientData, Tcl_Interp *interp); static int DelCmdProc(ClientData clientData, - Tcl_Interp *interp, size_t argc, - const char **argv); + 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, size_t srcLen, int flags, + const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, - size_t dstLen, size_t *srcReadPtr, - size_t *dstWrotePtr, size_t *dstCharsPtr); + int dstLen, int *srcReadPtr, int *dstWrotePtr, + int *dstCharsPtr); static int EncodingFromUtfProc(ClientData clientData, - const char *src, size_t srcLen, int flags, + const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, - size_t dstLen, size_t *srcReadPtr, - size_t *dstWrotePtr, size_t *dstCharsPtr); + int dstLen, int *srcReadPtr, int *dstWrotePtr, + int *dstCharsPtr); static void ExitProcEven(ClientData clientData); static void ExitProcOdd(ClientData clientData); static int GetTimesCmd(ClientData clientData, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static void MainLoop(void); static int NoopCmd(ClientData clientData, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int NoopObjCmd(ClientData clientData, - Tcl_Interp *interp, size_t objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ObjTraceProc(ClientData clientData, - Tcl_Interp *interp, int level, - const char *command, - Tcl_Command commandToken, size_t objc, + 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); +#undef USE_OBSOLETE_FS_HOOKS +#ifdef USE_OBSOLETE_FS_HOOKS +static int TestaccessprocCmd(ClientData dummy, + Tcl_Interp *interp, int argc, const char **argv); +static int TestopenfilechannelprocCmd( + ClientData dummy, Tcl_Interp *interp, int argc, + const char **argv); +static int TeststatprocCmd(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 Tcl_Channel PretendTclpOpenFileChannel( + Tcl_Interp *interp, const char *fileName, + const char *modeString, int permissions); +static Tcl_Channel TestOpenFileChannelProc1( + Tcl_Interp *interp, const char *fileName, + const char *modeString, int permissions); +static Tcl_Channel TestOpenFileChannelProc2( + Tcl_Interp *interp, const char *fileName, + const char *modeString, int permissions); +static Tcl_Channel TestOpenFileChannelProc3( + Tcl_Interp *interp, const char *fileName, + const char *modeString, int permissions); +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); +#endif static int TestasyncCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestcmdinfoCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestcmdtokenCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestcmdtraceCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestconcatobjCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestcreatecommandCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestdcallCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestdelCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestdelassocdataCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestdoubledigitsObjCmd(ClientData dummy, - Tcl_Interp* interp, size_t objc, - Tcl_Obj* const objv[]); + Tcl_Interp* interp, + int objc, Tcl_Obj* const objv[]); static int TestdstringCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestencodingObjCmd(ClientData dummy, - Tcl_Interp *interp, size_t objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestevalexObjCmd(ClientData dummy, - Tcl_Interp *interp, size_t objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestevalobjvObjCmd(ClientData dummy, - Tcl_Interp *interp, size_t objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TesteventObjCmd(ClientData unused, - Tcl_Interp *interp, size_t argc, + 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, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestexprlongCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestexprlongobjCmd(ClientData dummy, - Tcl_Interp *interp, size_t objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestexprdoubleCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestexprdoubleobjCmd(ClientData dummy, - Tcl_Interp *interp, size_t objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestexprparserObjCmd(ClientData dummy, - Tcl_Interp *interp, size_t objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestexprstringCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestfileCmd(ClientData dummy, - Tcl_Interp *interp, size_t objc, Tcl_Obj *const objv[]); + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestfilelinkCmd(ClientData dummy, - Tcl_Interp *interp, size_t objc, - Tcl_Obj *const objv[]); + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestfeventCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestgetassocdataCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestgetintCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestgetplatformCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestgetvarfullnameCmd( ClientData dummy, Tcl_Interp *interp, - size_t objc, Tcl_Obj *const objv[]); + int objc, Tcl_Obj *const objv[]); static int TestinterpdeleteCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestlinkCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestlocaleCmd(ClientData dummy, - Tcl_Interp *interp, size_t objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int TestMathFunc(ClientData clientData, + Tcl_Interp *interp, Tcl_Value *args, + Tcl_Value *resultPtr); +static int TestMathFunc2(ClientData clientData, + Tcl_Interp *interp, Tcl_Value *args, + Tcl_Value *resultPtr); static int TestmainthreadCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestsetmainloopCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestexitmainloopCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestpanicCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); -static int TestparseargsCmd(ClientData dummy, - Tcl_Interp *interp, - size_t objc, Tcl_Obj *const objv[]); + Tcl_Interp *interp, int argc, const char **argv); static int TestparserObjCmd(ClientData dummy, - Tcl_Interp *interp, size_t objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestparsevarObjCmd(ClientData dummy, - Tcl_Interp *interp, size_t objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestparsevarnameObjCmd(ClientData dummy, - Tcl_Interp *interp, size_t objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestregexpObjCmd(ClientData dummy, - Tcl_Interp *interp, size_t objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestreturnObjCmd(ClientData dummy, - Tcl_Interp *interp, size_t objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static void TestregexpXflags(const char *string, - size_t length, int *cflagsPtr, int *eflagsPtr); +static void TestregexpXflags(char *string, + int length, int *cflagsPtr, int *eflagsPtr); static int TestsaveresultCmd(ClientData dummy, - Tcl_Interp *interp, size_t objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void TestsaveresultFree(char *blockPtr); static int TestsetassocdataCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestsetCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int Testset2Cmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestseterrorcodeCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestsetobjerrorcodeCmd( ClientData dummy, Tcl_Interp *interp, - size_t objc, Tcl_Obj *const objv[]); + int objc, Tcl_Obj *const objv[]); static int TestsetplatformCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TeststaticpkgCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TesttranslatefilenameCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestupvarCmd(ClientData dummy, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestWrongNumArgsObjCmd( ClientData clientData, Tcl_Interp *interp, - size_t objc, Tcl_Obj *const objv[]); + int objc, Tcl_Obj *const objv[]); static int TestGetIndexFromObjStructObjCmd( ClientData clientData, Tcl_Interp *interp, - size_t objc, Tcl_Obj *const objv[]); + int objc, Tcl_Obj *const objv[]); static int TestChannelCmd(ClientData clientData, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestChannelEventCmd(ClientData clientData, - Tcl_Interp *interp, size_t argc, - const char **argv); + Tcl_Interp *interp, int argc, const char **argv); static int TestFilesystemObjCmd(ClientData dummy, - Tcl_Interp *interp, size_t objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestSimpleFilesystemObjCmd( - ClientData dummy, Tcl_Interp *interp, - size_t objc, Tcl_Obj *const objv[]); + 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 Tcl_FSStatProc TestReportStat; -static Tcl_FSAccessProc TestReportAccess; -static Tcl_FSOpenFileChannelProc TestReportOpenFileChannel; -static Tcl_FSMatchInDirectoryProc TestReportMatchInDirectory; -static Tcl_FSChdirProc TestReportChdir; -static Tcl_FSLstatProc TestReportLstat; -static Tcl_FSCopyFileProc TestReportCopyFile; -static Tcl_FSDeleteFileProc TestReportDeleteFile; -static Tcl_FSRenameFileProc TestReportRenameFile; -static Tcl_FSCreateDirectoryProc TestReportCreateDirectory; -static Tcl_FSCopyDirectoryProc TestReportCopyDirectory; -static Tcl_FSRemoveDirectoryProc TestReportRemoveDirectory; -static int TestReportLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, - Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); -static Tcl_FSLinkProc TestReportLink; -static Tcl_FSFileAttrStringsProc TestReportFileAttrStrings; -static Tcl_FSFileAttrsGetProc TestReportFileAttrsGet; -static Tcl_FSFileAttrsSetProc TestReportFileAttrsSet; -static Tcl_FSUtimeProc TestReportUtime; -static Tcl_FSNormalizePathProc TestReportNormalizePath; -static Tcl_FSPathInFilesystemProc TestReportInFilesystem; -static Tcl_FSFreeInternalRepProc TestReportFreeInternalRep; -static Tcl_FSDupInternalRepProc TestReportDupInternalRep; - -static Tcl_FSStatProc SimpleStat; -static Tcl_FSAccessProc SimpleAccess; -static Tcl_FSOpenFileChannelProc SimpleOpenFileChannel; -static Tcl_FSListVolumesProc SimpleListVolumes; -static Tcl_FSPathInFilesystemProc SimplePathInFilesystem; +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 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 Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory; +static int SimpleMatchInDirectory( + Tcl_Interp *interp, Tcl_Obj *resultPtr, + Tcl_Obj *dirPtr, const char *pattern, + Tcl_GlobTypeData *types); static int TestNumUtfCharsCmd(ClientData clientData, - Tcl_Interp *interp, size_t objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int TestHashSystemHashCmd(ClientData clientData, - Tcl_Interp *interp, size_t objc, - Tcl_Obj *const objv[]); -static int TestNRELevels(ClientData clientData, - Tcl_Interp *interp, size_t objc, - Tcl_Obj *const objv[]); -static int TestInterpResolverCmd(ClientData clientData, - Tcl_Interp *interp, size_t objc, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); #if defined(HAVE_CPUID) || defined(__WIN32__) -static int TestcpuidCmd(ClientData dummy, - Tcl_Interp* interp, size_t objc, - Tcl_Obj *const objv[]); +static int TestcpuidCmd (ClientData dummy, + Tcl_Interp* interp, int objc, + Tcl_Obj *CONST objv[]); #endif -static const Tcl_Filesystem testReportingFilesystem = { +static Tcl_Filesystem testReportingFilesystem = { "reporting", sizeof(Tcl_Filesystem), TCL_FILESYSTEM_VERSION_1, - TestReportInFilesystem, /* path in */ - TestReportDupInternalRep, - TestReportFreeInternalRep, + &TestReportInFilesystem, /* path in */ + &TestReportDupInternalRep, + &TestReportFreeInternalRep, NULL, /* native to norm */ NULL, /* convert to native */ - TestReportNormalizePath, + &TestReportNormalizePath, NULL, /* path type */ NULL, /* separator */ - TestReportStat, - TestReportAccess, - TestReportOpenFileChannel, - TestReportMatchInDirectory, - TestReportUtime, - TestReportLink, + &TestReportStat, + &TestReportAccess, + &TestReportOpenFileChannel, + &TestReportMatchInDirectory, + &TestReportUtime, + &TestReportLink, NULL /* list volumes */, - TestReportFileAttrStrings, - TestReportFileAttrsGet, - TestReportFileAttrsSet, - TestReportCreateDirectory, - TestReportRemoveDirectory, - TestReportDeleteFile, - TestReportCopyFile, - TestReportRenameFile, - TestReportCopyDirectory, - TestReportLstat, - (Tcl_FSLoadFileProc *) TestReportLoadFile, + &TestReportFileAttrStrings, + &TestReportFileAttrsGet, + &TestReportFileAttrsSet, + &TestReportCreateDirectory, + &TestReportRemoveDirectory, + &TestReportDeleteFile, + &TestReportCopyFile, + &TestReportRenameFile, + &TestReportCopyDirectory, + &TestReportLstat, + (Tcl_FSLoadFileProc *) &TestReportLoadFile, NULL /* cwd */, - TestReportChdir + &TestReportChdir }; -static const Tcl_Filesystem simpleFilesystem = { +static Tcl_Filesystem simpleFilesystem = { "simple", sizeof(Tcl_Filesystem), TCL_FILESYSTEM_VERSION_1, - SimplePathInFilesystem, + &SimplePathInFilesystem, NULL, NULL, /* No internal to normalized, since we don't create any @@ -506,14 +497,14 @@ static const Tcl_Filesystem simpleFilesystem = { NULL, NULL, NULL, - SimpleStat, - SimpleAccess, - SimpleOpenFileChannel, - SimpleMatchInDirectory, + &SimpleStat, + &SimpleAccess, + &SimpleOpenFileChannel, + &SimpleMatchInDirectory, NULL, /* We choose not to support symbolic links inside our vfs's */ NULL, - SimpleListVolumes, + &SimpleListVolumes, NULL, NULL, NULL, @@ -537,6 +528,15 @@ static const 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: + */ + +extern int TclplatformtestInit(Tcl_Interp *interp); +extern int TclThread_Init(Tcl_Interp *interp); + +/* *---------------------------------------------------------------------- * * Tcltest_Init -- @@ -559,24 +559,16 @@ int Tcltest_Init( Tcl_Interp *interp) /* Interpreter for application. */ { + Tcl_ValueType t3ArgTypes[2]; + Tcl_Obj *listPtr; Tcl_Obj **objv; - size_t objc; - int index; - static const char *const specialOptions[] = { + int objc, index; + static const char *specialOptions[] = { "-appinitprocerror", "-appinitprocdeleteinterp", "-appinitprocclosestderr", "-appinitprocsetrcfile", NULL }; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { - return TCL_ERROR; - } - if (Tcl_TomMath_InitStubs(interp, TCL_VERSION) == NULL) { - return TCL_ERROR; - } - if (Tcl_OOInitStubs(interp) == NULL) { - return TCL_ERROR; - } /* TIP #268: Full patchlevel instead of just major.minor */ if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) { @@ -587,142 +579,143 @@ Tcltest_Init( * Create additional commands and math functions for testing Tcl. */ - Tcl_CreateCommand(interp, "gettimes", GetTimesCmd, NULL, NULL); - Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, 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, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct", - TestGetIndexFromObjStructObjCmd, NULL, NULL); - Tcl_CreateCommand(interp, "testasync", TestasyncCmd, NULL, NULL); + TestGetIndexFromObjStructObjCmd, (ClientData) 0, NULL); +#ifdef USE_OBSOLETE_FS_HOOKS + Tcl_CreateCommand(interp, "testaccessproc", TestaccessprocCmd, (ClientData) 0, + NULL); + Tcl_CreateCommand(interp, "testopenfilechannelproc", + TestopenfilechannelprocCmd, (ClientData) 0, NULL); + Tcl_CreateCommand(interp, "teststatproc", TeststatprocCmd, (ClientData) 0, + NULL); +#endif + Tcl_CreateCommand(interp, "testasync", TestasyncCmd, (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testchannel", TestChannelCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd, - NULL, NULL); - Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, NULL, + (ClientData) 0, NULL); + Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, (ClientData) 0, NULL); - Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, NULL, + Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testconcatobj", TestconcatobjCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd, - NULL, NULL); - Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, NULL, NULL); - Tcl_CreateCommand(interp, "testdel", TestdelCmd, NULL, 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, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testdoubledigits", TestdoubledigitsObjCmd, NULL, NULL); Tcl_DStringInit(&dstring); - Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, NULL, + Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, (ClientData) 0, NULL); - Tcl_CreateObjCommand(interp, "testencoding", TestencodingObjCmd, NULL, + Tcl_CreateObjCommand(interp, "testencoding", TestencodingObjCmd, (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testevalex", TestevalexObjCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testevalobjv", TestevalobjvObjCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testevent", TesteventObjCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testexithandler", TestexithandlerCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testexprlong", TestexprlongCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testexprlongobj", TestexprlongobjCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testexprdouble", TestexprdoubleCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testexprdoubleobj", TestexprdoubleobjCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testexprparser", TestexprparserObjCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testexprstring", TestexprstringCmd, - NULL, NULL); - Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, NULL, + (ClientData) 0, NULL); + Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testfilelink", TestfilelinkCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testfile", TestfileCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testhashsystemhash", - TestHashSystemHashCmd, NULL, NULL); + TestHashSystemHashCmd, (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testgetint", TestgetintCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testgetvarfullname", - TestgetvarfullnameCmd, NULL, NULL); + TestgetvarfullnameCmd, (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd, - NULL, NULL); - Tcl_CreateCommand(interp, "testlink", TestlinkCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, NULL, + (ClientData) 0, NULL); + Tcl_CreateCommand(interp, "testlink", TestlinkCmd, (ClientData) 0, NULL); + Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, (ClientData) 0, NULL); - Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL); + Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testseterr", TestsetCmd, (ClientData) TCL_LEAVE_ERR_MSG, NULL); Tcl_CreateCommand(interp, "testset2", Testset2Cmd, (ClientData) TCL_LEAVE_ERR_MSG, NULL); Tcl_CreateCommand(interp, "testseterrorcode", TestseterrorcodeCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testsetobjerrorcode", - TestsetobjerrorcodeCmd, NULL, NULL); + TestsetobjerrorcodeCmd, (ClientData) 0, NULL); Tcl_CreateObjCommand(interp, "testnumutfchars", - TestNumUtfCharsCmd, NULL, NULL); + TestNumUtfCharsCmd, (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd, - NULL, NULL); + (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testtranslatefilename", - TesttranslatefilenameCmd, NULL, NULL); - Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL); - - Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL, + 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, "testmainthread", TestmainthreadCmd, (ClientData) 0, NULL); Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd, - NULL, NULL); + (ClientData) NULL, NULL); Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd, - NULL, NULL); + (ClientData) NULL, NULL); #if defined(HAVE_CPUID) || defined(__WIN32__) Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd, (ClientData) 0, NULL); #endif + t3ArgTypes[0] = TCL_EITHER; + t3ArgTypes[1] = TCL_EITHER; + Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2, + (ClientData) 0); - Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd, - NULL, NULL); - - if (TclObjTest_Init(interp) != TCL_OK) { - return TCL_ERROR; - } - if (Procbodytest_Init(interp) != TCL_OK) { - return TCL_ERROR; - } #ifdef TCL_THREADS if (TclThread_Init(interp) != TCL_OK) { return TCL_ERROR; @@ -768,35 +761,6 @@ Tcltest_Init( return TclplatformtestInit(interp); } - -/* - *---------------------------------------------------------------------- - * - * Tcltest_SafeInit -- - * - * 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. - * - * Side effects: - * Depends on the startup script. - * - *---------------------------------------------------------------------- - */ - -int -Tcltest_SafeInit( - Tcl_Interp *interp) /* Interpreter for application. */ -{ - if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { - return TCL_ERROR; - } - return Procbodytest_SafeInit(interp); -} /* *---------------------------------------------------------------------- @@ -820,12 +784,13 @@ static int TestasyncCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { TestAsyncHandler *asyncPtr, *prevPtr; int id, code; static int nextId = 1; + char buf[TCL_INTEGER_SPACE]; if (argc < 2) { wrongNumArgs: @@ -836,7 +801,7 @@ TestasyncCmd( if (argc != 3) { goto wrongNumArgs; } - asyncPtr = ckalloc(sizeof(TestAsyncHandler)); + asyncPtr = (TestAsyncHandler *) ckalloc(sizeof(TestAsyncHandler)); asyncPtr->command = ckalloc(strlen(argv[2]) + 1); strcpy(asyncPtr->command, argv[2]); Tcl_MutexLock(&asyncTestMutex); @@ -847,7 +812,8 @@ TestasyncCmd( asyncPtr->nextPtr = firstHandler; firstHandler = asyncPtr; Tcl_MutexUnlock(&asyncTestMutex); - Tcl_SetObjResult(interp, Tcl_NewIntObj(asyncPtr->id)); + TclFormatInt(buf, asyncPtr->id); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if (strcmp(argv[1], "delete") == 0) { if (argc == 2) { Tcl_MutexLock(&asyncTestMutex); @@ -856,7 +822,7 @@ TestasyncCmd( firstHandler = asyncPtr->nextPtr; Tcl_AsyncDelete(asyncPtr->handler); ckfree(asyncPtr->command); - ckfree(asyncPtr); + ckfree((char *) asyncPtr); } Tcl_MutexUnlock(&asyncTestMutex); return TCL_OK; @@ -880,7 +846,7 @@ TestasyncCmd( } Tcl_AsyncDelete(asyncPtr->handler); ckfree(asyncPtr->command); - ckfree(asyncPtr); + ckfree((char *) asyncPtr); break; } Tcl_MutexUnlock(&asyncTestMutex); @@ -892,7 +858,7 @@ TestasyncCmd( || (Tcl_GetInt(interp, argv[4], &code) != TCL_OK)) { return TCL_ERROR; } - Tcl_MutexLock(&asyncTestMutex); + Tcl_MutexLock(&asyncTestMutex); for (asyncPtr = firstHandler; asyncPtr != NULL; asyncPtr = asyncPtr->nextPtr) { if (asyncPtr->id == id) { @@ -900,8 +866,8 @@ TestasyncCmd( break; } } - Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], TCL_STRLEN)); - Tcl_MutexUnlock(&asyncTestMutex); + Tcl_MutexUnlock(&asyncTestMutex); + Tcl_SetResult(interp, (char *)argv[3], TCL_VOLATILE); return code; #ifdef TCL_THREADS } else if (strcmp(argv[1], "marklater") == 0) { @@ -917,7 +883,7 @@ TestasyncCmd( if (asyncPtr->id == id) { Tcl_ThreadId threadID; if (Tcl_CreateThread(&threadID, AsyncThreadProc, - INT2PTR(id), TCL_THREAD_STACK_DEFAULT, + (ClientData) INT2PTR(id), TCL_THREAD_STACK_DEFAULT, TCL_THREAD_NOFLAGS) != TCL_OK) { Tcl_SetResult(interp, "can't create thread", TCL_STATIC); Tcl_MutexUnlock(&asyncTestMutex); @@ -943,7 +909,7 @@ TestasyncCmd( static int AsyncHandlerProc( - ClientData clientData, /* If of TestAsyncHandler structure. + ClientData clientData, /* If of TestAsyncHandler structure. * in global list. */ Tcl_Interp *interp, /* Interpreter in which command was * executed, or NULL. */ @@ -980,7 +946,7 @@ AsyncHandlerProc( * invoked, it's possible. Better error checking is needed here. */ } - ckfree(cmd); + ckfree((char *)cmd); return code; } @@ -1047,7 +1013,7 @@ static int TestcmdinfoCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_CmdInfo info; @@ -1097,13 +1063,13 @@ TestcmdinfoCmd( info.proc = CmdProc2; info.clientData = (ClientData) "new_command_data"; info.objProc = NULL; - info.objClientData = NULL; + info.objClientData = (ClientData) NULL; info.deleteProc = CmdDelProc2; info.deleteData = (ClientData) "new_delete_data"; if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); + Tcl_SetResult(interp, "0", TCL_STATIC); } else { - Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); + Tcl_SetResult(interp, "1", TCL_STATIC); } } else { Tcl_AppendResult(interp, "bad option \"", argv[1], @@ -1118,7 +1084,7 @@ static int CmdProc1( ClientData clientData, /* String to return. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_AppendResult(interp, "CmdProc1 ", (char *) clientData, NULL); @@ -1130,7 +1096,7 @@ static int CmdProc2( ClientData clientData, /* String to return. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData, NULL); @@ -1142,8 +1108,8 @@ CmdDelProc1( ClientData clientData) /* String to save. */ { Tcl_DStringInit(&delString); - Tcl_DStringAppend(&delString, "CmdDelProc1 ", TCL_STRLEN); - Tcl_DStringAppend(&delString, (char *) clientData, TCL_STRLEN); + Tcl_DStringAppend(&delString, "CmdDelProc1 ", -1); + Tcl_DStringAppend(&delString, (char *) clientData, -1); } static void @@ -1151,8 +1117,8 @@ CmdDelProc2( ClientData clientData) /* String to save. */ { Tcl_DStringInit(&delString); - Tcl_DStringAppend(&delString, "CmdDelProc2 ", TCL_STRLEN); - Tcl_DStringAppend(&delString, (char *) clientData, TCL_STRLEN); + Tcl_DStringAppend(&delString, "CmdDelProc2 ", -1); + Tcl_DStringAppend(&delString, (char *) clientData, -1); } /* @@ -1177,7 +1143,7 @@ static int TestcmdtokenCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_Command token; @@ -1241,7 +1207,7 @@ static int TestcmdtraceCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_DString buffer; @@ -1255,7 +1221,8 @@ TestcmdtraceCmd( if (strcmp(argv[1], "tracetest") == 0) { Tcl_DStringInit(&buffer); - cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer); + cmdTrace = Tcl_CreateTrace(interp, 50000, + (Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer); result = Tcl_Eval(interp, argv[2]); if (result == TCL_OK) { Tcl_ResetResult(interp); @@ -1268,16 +1235,17 @@ TestcmdtraceCmd( * 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 - * TclNRExecuteByteCode. + * TclExecuteByteCode. */ - cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceDeleteProc, NULL); + cmdTrace = Tcl_CreateTrace(interp, 50000, + (Tcl_CmdTraceProc *) CmdTraceDeleteProc, (ClientData) NULL); Tcl_Eval(interp, argv[2]); } else if (strcmp(argv[1], "leveltest") == 0) { Interp *iPtr = (Interp *) interp; Tcl_DStringInit(&buffer); - cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4, CmdTraceProc, - &buffer); + cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4, + (Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer); result = Tcl_Eval(interp, argv[2]); if (result == TCL_OK) { Tcl_ResetResult(interp); @@ -1308,8 +1276,10 @@ TestcmdtraceCmd( Tcl_Trace t1, t2; Tcl_DStringInit(&buffer); - t1 = Tcl_CreateTrace(interp, 1, CmdTraceProc, &buffer); - t2 = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer); + t1 = Tcl_CreateTrace(interp, 1, + (Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer); + t2 = Tcl_CreateTrace(interp, 50000, + (Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer); result = Tcl_Eval(interp, argv[2]); if (result == TCL_OK) { Tcl_ResetResult(interp); @@ -1338,8 +1308,8 @@ CmdTraceProc( Tcl_CmdProc *cmdProc, /* Points to command's command procedure. */ ClientData cmdClientData, /* Client data associated with command * procedure. */ - size_t argc, /* Number of arguments. */ - const char *argv[]) /* Argument strings. */ + int argc, /* Number of arguments. */ + char **argv) /* Argument strings. */ { Tcl_DString *bufPtr = (Tcl_DString *) clientData; int i; @@ -1363,13 +1333,13 @@ CmdTraceDeleteProc( Tcl_CmdProc *cmdProc, /* Points to command's command procedure. */ ClientData cmdClientData, /* Client data associated with command * procedure. */ - size_t argc, /* Number of arguments. */ - const char *argv[]) /* Argument strings. */ + int argc, /* Number of arguments. */ + char **argv) /* Argument strings. */ { /* * Remove ourselves to test whether calling Tcl_DeleteTrace within a trace - * callback causes the for loop in TclNRExecuteByteCode that calls traces - * to reference freed memory. + * callback causes the for loop in TclExecuteByteCode that calls traces to + * reference freed memory. */ Tcl_DeleteTrace(interp, cmdTrace); @@ -1382,13 +1352,13 @@ ObjTraceProc( int level, /* Execution level */ const char *command, /* Command being executed */ Tcl_Command token, /* Command information */ - size_t objc, /* Parameter count */ + int objc, /* Parameter count */ Tcl_Obj *const objv[]) /* Parameter list */ { const char *word = Tcl_GetString(objv[0]); if (!strcmp(word, "Error")) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(command, TCL_STRLEN)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1)); return TCL_ERROR; } else if (!strcmp(word, "Break")) { return TCL_BREAK; @@ -1436,7 +1406,7 @@ static int TestcreatecommandCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { if (argc != 2) { @@ -1446,12 +1416,12 @@ TestcreatecommandCmd( } if (strcmp(argv[1], "create") == 0) { Tcl_CreateCommand(interp, "test_ns_basic::createdcommand", - CreatedCommandProc, NULL, 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, NULL, NULL); + CreatedCommandProc2, (ClientData) NULL, NULL); } else if (strcmp(argv[1], "delete2") == 0) { Tcl_DeleteCommand(interp, "value:at:"); } else { @@ -1466,7 +1436,7 @@ static int CreatedCommandProc( ClientData clientData, /* String to return. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_CmdInfo info; @@ -1488,7 +1458,7 @@ static int CreatedCommandProc2( ClientData clientData, /* String to return. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_CmdInfo info; @@ -1527,11 +1497,10 @@ static int TestdcallCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { - size_t i; - int id; + int i, id; delInterp = Tcl_CreateInterp(); Tcl_DStringInit(&delString); @@ -1540,9 +1509,11 @@ TestdcallCmd( return TCL_ERROR; } if (id < 0) { - Tcl_DontCallWhenDeleted(delInterp, DelCallbackProc, INT2PTR(-id)); + Tcl_DontCallWhenDeleted(delInterp, DelCallbackProc, + (ClientData) INT2PTR(-id)); } else { - Tcl_CallWhenDeleted(delInterp, DelCallbackProc, INT2PTR(id)); + Tcl_CallWhenDeleted(delInterp, DelCallbackProc, + (ClientData) INT2PTR(id)); } } Tcl_DeleteInterp(delInterp); @@ -1574,14 +1545,14 @@ DelCallbackProc( * * TestdelCmd -- * - * This procedure implements the "testdcall" command. It is used - * to test Tcl_CallWhenDeleted. + * This procedure implements the "testdel" command. It is used + * to test calling of command deletion callbacks. * * Results: * A standard Tcl result. * * Side effects: - * Creates and deletes interpreters. + * Creates a command. * *---------------------------------------------------------------------- */ @@ -1591,7 +1562,7 @@ static int TestdelCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { DelCmd *dPtr; @@ -1607,9 +1578,9 @@ TestdelCmd( return TCL_ERROR; } - dPtr = ckalloc(sizeof(DelCmd)); + dPtr = (DelCmd *) ckalloc(sizeof(DelCmd)); dPtr->interp = interp; - dPtr->deleteCmd = ckalloc(strlen(argv[3]) + 1); + dPtr->deleteCmd = (char *) ckalloc((unsigned) (strlen(argv[3]) + 1)); strcpy(dPtr->deleteCmd, argv[3]); Tcl_CreateCommand(slave, argv[2], DelCmdProc, (ClientData) dPtr, @@ -1621,14 +1592,14 @@ static int DelCmdProc( ClientData clientData, /* String result to return. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { DelCmd *dPtr = (DelCmd *) clientData; Tcl_AppendResult(interp, dPtr->deleteCmd, NULL); ckfree(dPtr->deleteCmd); - ckfree(dPtr); + ckfree((char *) dPtr); return TCL_OK; } @@ -1636,12 +1607,12 @@ static void DelDeleteProc( ClientData clientData) /* String command to evaluate. */ { - DelCmd *dPtr = clientData; + DelCmd *dPtr = (DelCmd *) clientData; Tcl_Eval(dPtr->interp, dPtr->deleteCmd); Tcl_ResetResult(dPtr->interp); ckfree(dPtr->deleteCmd); - ckfree(dPtr); + ckfree((char *) dPtr); } /* @@ -1666,7 +1637,7 @@ static int TestdelassocdataCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { if (argc != 2) { @@ -1700,11 +1671,14 @@ TestdelassocdataCmd( */ static int -TestdoubledigitsObjCmd( - ClientData unused, /* NULL */ - Tcl_Interp* interp, /* Tcl interpreter */ - size_t objc, /* Parameter count */ - Tcl_Obj* const objv[]) /* Parameter vector */ +TestdoubledigitsObjCmd(ClientData unused, + /* NULL */ + Tcl_Interp* interp, + /* Tcl interpreter */ + int objc, + /* Parameter count */ + Tcl_Obj* const objv[]) + /* Parameter vector */ { static const char* options[] = { "shortest", @@ -1748,15 +1722,14 @@ TestdoubledigitsObjCmd( if (status != TCL_OK || Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK || Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type", - TCL_EXACT, &type) != TCL_OK) { + TCL_EXACT, &type) != TCL_OK) { fprintf(stderr, "bad value? %g\n", d); return TCL_ERROR; } type = types[type]; if (objc > 4) { if (strcmp(Tcl_GetString(objv[4]), "shorten")) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", - TCL_STRLEN)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", -1)); return TCL_ERROR; } type |= TCL_DD_SHORTEN_FLAG; @@ -1794,7 +1767,7 @@ static int TestdstringCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int count; @@ -1841,13 +1814,13 @@ TestdstringCmd( } else if (strcmp(argv[2], "staticlarge") == 0) { Tcl_SetResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", TCL_STATIC); } else if (strcmp(argv[2], "free") == 0) { - char *s = ckalloc(100); - strcpy(s, "This is a malloc-ed string"); - Tcl_SetResult(interp, s, TCL_DYNAMIC); + Tcl_SetResult(interp, (char *) ckalloc(100), TCL_DYNAMIC); + strcpy(interp->result, "This is a malloc-ed string"); } else if (strcmp(argv[2], "special") == 0) { - char *s = ((char *) ckalloc(100)) + 16; - strcpy(s, "This is a specially-allocated string"); - Tcl_SetResult(interp, s, SpecialFree); + interp->result = (char *) ckalloc(100); + interp->result += 4; + interp->freeProc = SpecialFree; + strcpy(interp->result, "This is a specially-allocated string"); } else { Tcl_AppendResult(interp, "bad gresult option \"", argv[2], "\": must be staticsmall, staticlarge, free, or special", @@ -1856,11 +1829,13 @@ TestdstringCmd( } Tcl_DStringGetResult(interp, &dstring); } else if (strcmp(argv[1], "length") == 0) { + char buf[TCL_INTEGER_SPACE]; if (argc != 2) { goto wrongNumArgs; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_DStringLength(&dstring))); + TclFormatInt(buf, Tcl_DStringLength(&dstring)); + Tcl_SetResult(interp, buf, TCL_VOLATILE); } else if (strcmp(argv[1], "result") == 0) { if (argc != 2) { goto wrongNumArgs; @@ -1896,7 +1871,7 @@ TestdstringCmd( static void SpecialFree(blockPtr) char *blockPtr; /* Block to free. */ { - ckfree(blockPtr - 16); + ckfree(blockPtr - 4); } /* @@ -1921,15 +1896,14 @@ static int TestencodingObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Encoding encoding; - int index; - size_t length; - const char *string; + int index, length; + char *string; TclEncoding *encodingPtr; - static const char *const optionStrings[] = { + static const char *optionStrings[] = { "create", "delete", NULL }; enum options { @@ -1948,15 +1922,15 @@ TestencodingObjCmd( if (objc != 5) { return TCL_ERROR; } - encodingPtr = ckalloc(sizeof(TclEncoding)); + encodingPtr = (TclEncoding *) ckalloc(sizeof(TclEncoding)); encodingPtr->interp = interp; string = Tcl_GetStringFromObj(objv[3], &length); - encodingPtr->toUtfCmd = ckalloc(length + 1); + encodingPtr->toUtfCmd = (char *) ckalloc((unsigned) (length + 1)); memcpy(encodingPtr->toUtfCmd, string, (unsigned) length + 1); string = Tcl_GetStringFromObj(objv[4], &length); - encodingPtr->fromUtfCmd = ckalloc(length + 1); + encodingPtr->fromUtfCmd = (char *) ckalloc((unsigned) (length + 1)); memcpy(encodingPtr->fromUtfCmd, string, (unsigned) (length + 1)); string = Tcl_GetStringFromObj(objv[2], &length); @@ -1987,20 +1961,20 @@ static int EncodingToUtfProc( ClientData clientData, /* TclEncoding structure. */ const char *src, /* Source string in specified encoding. */ - size_t srcLen, /* Source string length in bytes. */ + int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Current state. */ char *dst, /* Output buffer. */ - size_t dstLen, /* The maximum length of output buffer. */ - size_t *srcReadPtr, /* Filled with number of bytes read. */ - size_t *dstWrotePtr, /* Filled with number of bytes stored. */ - size_t *dstCharsPtr) /* Filled with number of chars stored. */ + int dstLen, /* The maximum length of output buffer. */ + int *srcReadPtr, /* Filled with number of bytes read. */ + int *dstWrotePtr, /* Filled with number of bytes stored. */ + int *dstCharsPtr) /* Filled with number of chars stored. */ { - size_t len; + int len; TclEncoding *encodingPtr; encodingPtr = (TclEncoding *) clientData; - Tcl_EvalEx(encodingPtr->interp, encodingPtr->toUtfCmd, -1, TCL_EVAL_GLOBAL); + Tcl_GlobalEval(encodingPtr->interp, encodingPtr->toUtfCmd); len = strlen(Tcl_GetStringResult(encodingPtr->interp)); if (len > dstLen) { @@ -2019,20 +1993,20 @@ static int EncodingFromUtfProc( ClientData clientData, /* TclEncoding structure. */ const char *src, /* Source string in specified encoding. */ - size_t srcLen, /* Source string length in bytes. */ + int srcLen, /* Source string length in bytes. */ int flags, /* Conversion control flags. */ Tcl_EncodingState *statePtr,/* Current state. */ char *dst, /* Output buffer. */ - size_t dstLen, /* The maximum length of output buffer. */ - size_t *srcReadPtr, /* Filled with number of bytes read. */ - size_t *dstWrotePtr, /* Filled with number of bytes stored. */ - size_t *dstCharsPtr) /* Filled with number of chars stored. */ + int dstLen, /* The maximum length of output buffer. */ + int *srcReadPtr, /* Filled with number of bytes read. */ + int *dstWrotePtr, /* Filled with number of bytes stored. */ + int *dstCharsPtr) /* Filled with number of chars stored. */ { - size_t len; + int len; TclEncoding *encodingPtr; encodingPtr = (TclEncoding *) clientData; - Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd, -1, TCL_EVAL_GLOBAL); + Tcl_GlobalEval(encodingPtr->interp, encodingPtr->fromUtfCmd); len = strlen(Tcl_GetStringResult(encodingPtr->interp)); if (len > dstLen) { @@ -2051,11 +2025,12 @@ static void EncodingFreeProc( ClientData clientData) /* ClientData associated with type. */ { - TclEncoding *encodingPtr = clientData; + TclEncoding *encodingPtr; - ckfree(encodingPtr->toUtfCmd); - ckfree(encodingPtr->fromUtfCmd); - ckfree(encodingPtr); + encodingPtr = (TclEncoding *) clientData; + ckfree((char *) encodingPtr->toUtfCmd); + ckfree((char *) encodingPtr->fromUtfCmd); + ckfree((char *) encodingPtr); } /* @@ -2079,16 +2054,15 @@ static int TestevalexObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t length; - int flags; - const char *script; + int length, flags; + char *script; flags = 0; if (objc == 3) { - const char *global = Tcl_GetStringFromObj(objv[2], &length); + char *global = Tcl_GetStringFromObj(objv[2], &length); if (strcmp(global, "global") != 0) { Tcl_AppendResult(interp, "bad value \"", global, "\": must be global", NULL); @@ -2125,7 +2099,7 @@ static int TestevalobjvObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int evalGlobal; @@ -2174,14 +2148,14 @@ static int TesteventObjCmd( ClientData unused, /* Not used */ Tcl_Interp *interp, /* Tcl interpreter */ - size_t objc, /* Parameter count */ + int objc, /* Parameter count */ Tcl_Obj *const objv[]) /* Parameter vector */ { - static const char *const subcommands[] = { /* Possible subcommands */ + static const char *subcommands[] = { /* Possible subcommands */ "queue", "delete", NULL }; int subCmdIndex; /* Index of the chosen subcommand */ - static const char *const positions[] = { /* Possible queue positions */ + static const char *positions[] = { /* Possible queue positions */ "head", "tail", "mark", NULL }; int posIndex; /* Index of the chosen position */ @@ -2194,7 +2168,7 @@ TesteventObjCmd( TestEvent *ev; /* Event to be queued */ if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "subcommand", @@ -2211,7 +2185,7 @@ TesteventObjCmd( "position specifier", TCL_EXACT, &posIndex) != TCL_OK) { return TCL_ERROR; } - ev = ckalloc(sizeof(TestEvent)); + ev = (TestEvent *) ckalloc(sizeof(TestEvent)); ev->header.proc = TesteventProc; ev->header.nextPtr = NULL; ev->interp = interp; @@ -2312,9 +2286,9 @@ TesteventDeleteProc( * to remove */ { TestEvent *ev; /* Event to examine */ - const char *evNameStr; + char *evNameStr; Tcl_Obj *targetName; /* Name of the event(s) to delete */ - const char *targetNameStr; + char *targetNameStr; if (event->proc != TesteventProc) { return 0; @@ -2353,7 +2327,7 @@ static int TestexithandlerCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int value; @@ -2429,7 +2403,7 @@ static int TestexprlongCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { long exprResult; @@ -2472,7 +2446,7 @@ static int TestexprlongobjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument objects. */ { long exprResult; @@ -2514,7 +2488,7 @@ static int TestexprdoubleCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { double exprResult; @@ -2558,7 +2532,7 @@ static int TestexprdoubleobjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument objects. */ { double exprResult; @@ -2600,7 +2574,7 @@ static int TestexprstringCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { if (argc != 2) { @@ -2632,7 +2606,7 @@ static int TestfilelinkCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Tcl_Obj *contents; @@ -2699,7 +2673,7 @@ static int TestgetassocdataCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { char *res; @@ -2737,10 +2711,10 @@ static int TestgetplatformCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { - static const char *const platformStrings[] = { "unix", "mac", "windows" }; + static const char *platformStrings[] = { "unix", "mac", "windows" }; TclPlatformType *platform; platform = TclGetPlatform(); @@ -2778,7 +2752,7 @@ static int TestinterpdeleteCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_Interp *slaveToDelete; @@ -2819,7 +2793,7 @@ static int TestlinkCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { static int intVar = 43; @@ -3069,12 +3043,12 @@ TestlinkCmd( if (strcmp(argv[5], "-") == 0) { stringVar = NULL; } else { - stringVar = ckalloc(strlen(argv[5]) + 1); + stringVar = (char *) ckalloc((unsigned) (strlen(argv[5]) + 1)); strcpy(stringVar, argv[5]); } } if (argv[6][0] != 0) { - tmp = Tcl_NewStringObj(argv[6], TCL_STRLEN); + tmp = Tcl_NewStringObj(argv[6], -1); if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; @@ -3132,7 +3106,7 @@ TestlinkCmd( } if (argv[15][0]) { Tcl_WideInt w; - tmp = Tcl_NewStringObj(argv[15], TCL_STRLEN); + tmp = Tcl_NewStringObj(argv[15], -1); if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; @@ -3176,13 +3150,13 @@ TestlinkCmd( if (strcmp(argv[5], "-") == 0) { stringVar = NULL; } else { - stringVar = ckalloc(strlen(argv[5]) + 1); + stringVar = (char *) ckalloc((unsigned) (strlen(argv[5]) + 1)); strcpy(stringVar, argv[5]); } Tcl_UpdateLinkedVar(interp, "string"); } if (argv[6][0] != 0) { - tmp = Tcl_NewStringObj(argv[6], TCL_STRLEN); + tmp = Tcl_NewStringObj(argv[6], -1); if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; @@ -3249,7 +3223,7 @@ TestlinkCmd( } if (argv[15][0]) { Tcl_WideInt w; - tmp = Tcl_NewStringObj(argv[15], TCL_STRLEN); + tmp = Tcl_NewStringObj(argv[15], -1); if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; @@ -3287,17 +3261,17 @@ static int TestlocaleCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { int index; - const char *locale; + char *locale; - static const char *const optionStrings[] = { - "ctype", "numeric", "time", "collate", "monetary", + static const char *optionStrings[] = { + "ctype", "numeric", "time", "collate", "monetary", "all", NULL }; - static const int lcTypes[] = { + static CONST int lcTypes[] = { LC_CTYPE, LC_NUMERIC, LC_TIME, LC_COLLATE, LC_MONETARY, LC_ALL }; @@ -3323,7 +3297,7 @@ TestlocaleCmd( } locale = setlocale(lcTypes[index], locale); if (locale) { - Tcl_SetStringObj(Tcl_GetObjResult(interp), locale, TCL_STRLEN); + Tcl_SetStringObj(Tcl_GetObjResult(interp), locale, -1); } return TCL_OK; } @@ -3331,6 +3305,144 @@ TestlocaleCmd( /* *---------------------------------------------------------------------- * + * TestMathFunc -- + * + * This is a user-defined math procedure to test out math procedures + * with no arguments. + * + * Results: + * A normal Tcl completion code. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +TestMathFunc( + ClientData clientData, /* Integer value to return. */ + Tcl_Interp *interp, /* Not used. */ + Tcl_Value *args, /* Not used. */ + Tcl_Value *resultPtr) /* Where to store result. */ +{ + resultPtr->type = TCL_INT; + resultPtr->intValue = PTR2INT(clientData); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TestMathFunc2 -- + * + * This is a user-defined math procedure to test out math procedures + * that do have arguments, in this case 2. + * + * Results: + * A normal Tcl completion code. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +TestMathFunc2( + 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 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) { + double d0 = i0; + double d1 = args[1].doubleValue; + + resultPtr->type = TCL_DOUBLE; + resultPtr->doubleValue = ((d0 > d1)? d0 : d1); + } else if (args[1].type == TCL_WIDE_INT) { + Tcl_WideInt w0 = Tcl_LongAsWide(i0); + Tcl_WideInt w1 = args[1].wideValue; + + resultPtr->type = TCL_WIDE_INT; + resultPtr->wideValue = ((w0 > w1)? w0 : w1); + } else { + Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC); + result = TCL_ERROR; + } + } 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) { + double d1 = args[1].doubleValue; + + resultPtr->type = TCL_DOUBLE; + resultPtr->doubleValue = ((d0 > d1)? d0 : d1); + } else if (args[1].type == TCL_WIDE_INT) { + double d1 = Tcl_WideAsDouble(args[1].wideValue); + + resultPtr->type = TCL_DOUBLE; + resultPtr->doubleValue = ((d0 > d1)? d0 : d1); + } else { + Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC); + result = TCL_ERROR; + } + } 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) { + double d0 = Tcl_WideAsDouble(w0); + double d1 = args[1].doubleValue; + + resultPtr->type = TCL_DOUBLE; + resultPtr->doubleValue = ((d0 > d1)? d0 : d1); + } else if (args[1].type == TCL_WIDE_INT) { + Tcl_WideInt w1 = args[1].wideValue; + + resultPtr->type = TCL_WIDE_INT; + resultPtr->wideValue = ((w0 > w1)? w0 : w1); + } else { + Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC); + result = TCL_ERROR; + } + } else { + Tcl_SetResult(interp, "T3: wrong type for arg 1", TCL_STATIC); + result = TCL_ERROR; + } + return result; +} + +/* + *---------------------------------------------------------------------- + * * CleanupTestSetassocdataTests -- * * This function is called when an interpreter is deleted to clean @@ -3350,7 +3462,7 @@ CleanupTestSetassocdataTests( ClientData clientData, /* Data to be released. */ Tcl_Interp *interp) /* Interpreter being deleted. */ { - ckfree(clientData); + ckfree((char *) clientData); } /* @@ -3374,12 +3486,11 @@ static int TestparserObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - const char *script; - int length; - size_t dummy; + char *script; + int length, dummy; Tcl_Parse parse; if (objc != 3) { @@ -3391,7 +3502,7 @@ TestparserObjCmd( return TCL_ERROR; } if (length == 0) { - length = (int) dummy; + length = dummy; } if (Tcl_ParseCommand(interp, script, length, 0, &parse) != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (remainder of script: \""); @@ -3431,12 +3542,11 @@ static int TestexprparserObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - const char *script; - int length; - size_t dummy; + char *script; + int length, dummy; Tcl_Parse parse; if (objc != 3) { @@ -3448,7 +3558,7 @@ TestexprparserObjCmd( return TCL_ERROR; } if (length == 0) { - length = (int) dummy; + length = dummy; } parse.commentStart = NULL; parse.commentSize = 0; @@ -3498,7 +3608,7 @@ PrintParse( Tcl_Obj *objPtr; const char *typeString; Tcl_Token *tokenPtr; - size_t i; + int i; objPtr = Tcl_GetObjResult(interp); if (parsePtr->commentSize > 0) { @@ -3547,14 +3657,15 @@ PrintParse( break; } Tcl_ListObjAppendElement(NULL, objPtr, - Tcl_NewStringObj(typeString, TCL_STRLEN)); + Tcl_NewStringObj(typeString, -1)); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(tokenPtr->start, tokenPtr->size)); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(tokenPtr->numComponents)); } - Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj( - parsePtr->commandStart + parsePtr->commandSize, TCL_STRLEN)); + Tcl_ListObjAppendElement(NULL, objPtr, + Tcl_NewStringObj(parsePtr->commandStart + parsePtr->commandSize, + -1)); } /* @@ -3562,8 +3673,8 @@ PrintParse( * * TestparsevarObjCmd -- * - * This procedure implements the "testparsevar" command. It is used for - * testing Tcl_ParseVar. + * This procedure implements the "testparsevar" command. It is + * used for testing Tcl_ParseVar. * * Results: * A standard Tcl result. @@ -3578,7 +3689,7 @@ static int TestparsevarObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { const char *value, *name, *termPtr; @@ -3619,12 +3730,11 @@ static int TestparsevarnameObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - const char *script; - int append, length; - size_t dummy; + char *script; + int append, length, dummy; Tcl_Parse parse; if (objc != 4) { @@ -3636,7 +3746,7 @@ TestparsevarnameObjCmd( return TCL_ERROR; } if (length == 0) { - length = (int) dummy; + length = dummy; } if (Tcl_GetIntFromObj(interp, objv[3], &append)) { return TCL_ERROR; @@ -3685,16 +3795,16 @@ static int TestregexpObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i, ii, indices, match, about, hasxflags, cflags, eflags; - size_t stringLength; + int i, ii, indices, stringLength, match, about; + int hasxflags, cflags, eflags; Tcl_RegExp regExpr; - const char *string; + char *string; Tcl_Obj *objPtr; Tcl_RegExpInfo info; - static const char *const options[] = { + static const char *options[] = { "-indices", "-nocase", "-about", "-expanded", "-line", "-linestop", "-lineanchor", "-xflags", @@ -3714,7 +3824,7 @@ TestregexpObjCmd( hasxflags = 0; for (i = 1; i < objc; i++) { - const char *name; + char *name; int index; name = Tcl_GetString(objv[i]); @@ -3759,7 +3869,7 @@ TestregexpObjCmd( endOfForLoop: if (objc - i < hasxflags + 2 - about) { Tcl_WrongNumArgs(interp, 1, objv, - "?-switch ...? exp string ?matchVar? ?subMatchVar ...?"); + "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"); return TCL_ERROR; } objc -= i; @@ -3799,7 +3909,7 @@ TestregexpObjCmd( Tcl_SetIntObj(Tcl_GetObjResult(interp), 0); if (objc > 2 && (cflags®_EXPECT) && indices) { - const char *varName; + char *varName; const char *value; int start, end; char resinfo[TCL_INTEGER_SPACE * 2]; @@ -3814,7 +3924,7 @@ TestregexpObjCmd( return TCL_ERROR; } } else if (cflags & TCL_REG_CANMATCH) { - const char *varName; + char *varName; const char *value; char resinfo[TCL_INTEGER_SPACE * 2]; @@ -3883,8 +3993,10 @@ TestregexpObjCmd( info.matches[ii].end - 1); } } - valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, TCL_LEAVE_ERR_MSG); + valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, 0); if (valuePtr == NULL) { + Tcl_AppendResult(interp, "couldn't set variable \"", + Tcl_GetString(varPtr), "\"", NULL); return TCL_ERROR; } } @@ -3916,13 +4028,12 @@ TestregexpObjCmd( static void TestregexpXflags( - const char *string, /* The string of flags. */ - size_t length, /* The length of the string in bytes. */ + char *string, /* The string of flags. */ + int length, /* The length of the string in bytes. */ int *cflagsPtr, /* compile flags word */ int *eflagsPtr) /* exec flags word */ { - size_t i; - int cflags, eflags; + int i, cflags, eflags; cflags = *cflagsPtr; eflags = *eflagsPtr; @@ -4010,7 +4121,7 @@ static int TestreturnObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return TCL_RETURN; @@ -4038,7 +4149,7 @@ static int TestsetassocdataCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { char *buf, *oldData; @@ -4050,7 +4161,7 @@ TestsetassocdataCmd( return TCL_ERROR; } - buf = ckalloc(strlen(argv[2]) + 1); + buf = ckalloc((unsigned) strlen(argv[2]) + 1); strcpy(buf, argv[2]); /* @@ -4090,7 +4201,7 @@ static int TestsetplatformCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { size_t length; @@ -4139,7 +4250,7 @@ static int TeststaticpkgCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int safe, loaded; @@ -4155,8 +4266,8 @@ TeststaticpkgCmd( if (Tcl_GetInt(interp, argv[3], &loaded) != TCL_OK) { return TCL_ERROR; } - tclStubsPtr->tcl_StaticPackage((loaded) ? interp : NULL, argv[1], - StaticInitProc, (safe) ? StaticInitProc : NULL); + Tcl_StaticPackage((loaded) ? interp : NULL, argv[1], StaticInitProc, + (safe) ? StaticInitProc : NULL); return TCL_OK; } @@ -4190,7 +4301,7 @@ static int TesttranslatefilenameCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_DString buffer; @@ -4232,7 +4343,7 @@ static int TestupvarCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int flags = 0; @@ -4285,7 +4396,7 @@ static int TestseterrorcodeCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { if (argc > 6) { @@ -4320,7 +4431,7 @@ static int TestsetobjerrorcodeCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Tcl_SetObjErrorCode(interp, Tcl_ConcatObj(objc - 1, objv + 1)); @@ -4349,7 +4460,7 @@ static int TestfeventCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { static Tcl_Interp *interp2 = NULL; @@ -4358,7 +4469,7 @@ TestfeventCmd( if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option ?arg ...?", NULL); + " option ?arg arg ...?", NULL); return TCL_ERROR; } if (strcmp(argv[1], "cmd") == 0) { @@ -4368,7 +4479,7 @@ TestfeventCmd( return TCL_ERROR; } if (interp2 != NULL) { - code = Tcl_EvalEx(interp2, argv[2], -1, TCL_EVAL_GLOBAL); + code = Tcl_GlobalEval(interp2, argv[2]); Tcl_SetObjResult(interp, Tcl_GetObjResult(interp2)); return code; } else { @@ -4421,7 +4532,7 @@ static int TestpanicCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { const char *argString; @@ -4433,21 +4544,21 @@ TestpanicCmd( argString = Tcl_Merge(argc-1, argv+1); Tcl_Panic("%s", argString); - ckfree(argString); + ckfree((char *)argString); return TCL_OK; } - + static int TestfileCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ Tcl_Obj *const argv[]) /* The argument objects. */ { int force, i, j, result; Tcl_Obj *error = NULL; - const char *subcmd; + char *subcmd; if (argc < 3) { return TCL_ERROR; @@ -4524,10 +4635,10 @@ static int TestgetvarfullnameCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - const char *name, *arg; + char *name, *arg; int flags = 0; Tcl_Namespace *namespacePtr; Tcl_CallFrame *framePtr; @@ -4602,7 +4713,7 @@ static int GetTimesCmd( ClientData unused, /* Unused. */ Tcl_Interp *interp, /* The current interpreter. */ - size_t argc, /* The number of arguments. */ + int argc, /* The number of arguments. */ const char **argv) /* The argument strings. */ { Interp *iPtr = (Interp *) interp; @@ -4617,8 +4728,8 @@ GetTimesCmd( fprintf(stderr, "alloc & free 100000 6 word items\n"); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { - objPtr = ckalloc(sizeof(Tcl_Obj)); - ckfree(objPtr); + objPtr = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj)); + ckfree((char *) objPtr); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); @@ -4626,10 +4737,10 @@ GetTimesCmd( /* alloc 5000 times */ fprintf(stderr, "alloc 5000 6 word items\n"); - objv = ckalloc(5000 * sizeof(Tcl_Obj *)); + objv = (Tcl_Obj **) ckalloc(5000 * sizeof(Tcl_Obj *)); Tcl_GetTime(&start); for (i = 0; i < 5000; i++) { - objv[i] = ckalloc(sizeof(Tcl_Obj)); + objv[i] = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj)); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); @@ -4639,7 +4750,7 @@ GetTimesCmd( fprintf(stderr, "free 5000 6 word items\n"); Tcl_GetTime(&start); for (i = 0; i < 5000; i++) { - ckfree(objv[i]); + ckfree((char *) objv[i]); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); @@ -4665,11 +4776,11 @@ GetTimesCmd( Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); fprintf(stderr, " %.3f usec per Tcl_DecrRefCount\n", timePer/5000); - ckfree(objv); + ckfree((char *) objv); /* TclGetString 100000 times */ fprintf(stderr, "TclGetStringFromObj of \"12345\" 100000 times\n"); - objPtr = Tcl_NewStringObj("12345", TCL_STRLEN); + objPtr = Tcl_NewStringObj("12345", -1); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { (void) TclGetString(objPtr); @@ -4781,7 +4892,7 @@ static int NoopCmd( ClientData unused, /* Unused. */ Tcl_Interp *interp, /* The current interpreter. */ - size_t argc, /* The number of arguments. */ + int argc, /* The number of arguments. */ const char **argv) /* The argument strings. */ { return TCL_OK; @@ -4808,7 +4919,7 @@ static int NoopObjCmd( ClientData unused, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { return TCL_OK; @@ -4836,7 +4947,7 @@ static int TestsetCmd( ClientData data, /* Additional flags for Get/SetVar2. */ register Tcl_Interp *interp,/* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int flags = PTR2INT(data); @@ -4868,7 +4979,7 @@ static int Testset2Cmd( ClientData data, /* Additional flags for Get/SetVar2. */ register Tcl_Interp *interp,/* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { int flags = PTR2INT(data); @@ -4919,14 +5030,13 @@ static int TestsaveresultCmd( ClientData dummy, /* Not used. */ register Tcl_Interp *interp,/* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - Interp* iPtr = (Interp*) interp; int discard, result, index; Tcl_SavedResult state; Tcl_Obj *objPtr; - static const char *const optionStrings[] = { + static const char *optionStrings[] = { "append", "dynamic", "free", "object", "small", NULL }; enum options { @@ -4965,10 +5075,10 @@ TestsaveresultCmd( break; } case RESULT_DYNAMIC: - Tcl_SetResult(interp, (char *)"dynamic result", TestsaveresultFree); + Tcl_SetResult(interp, "dynamic result", TestsaveresultFree); break; case RESULT_OBJECT: - objPtr = Tcl_NewStringObj("object result", TCL_STRLEN); + objPtr = Tcl_NewStringObj("object result", -1); Tcl_SetObjResult(interp, objPtr); break; } @@ -4991,7 +5101,7 @@ TestsaveresultCmd( switch ((enum options) index) { case RESULT_DYNAMIC: { - int present = iPtr->freeProc == TestsaveresultFree; + int present = interp->freeProc == TestsaveresultFree; int called = freeCount; Tcl_AppendElement(interp, called ? "called" : "notCalled"); @@ -5030,14 +5140,15 @@ TestsaveresultFree( { freeCount++; } +#ifdef USE_OBSOLETE_FS_HOOKS /* *---------------------------------------------------------------------- * - * TestmainthreadCmd -- + * TeststatprocCmd -- * - * Implements the "testmainthread" cmd that is used to test the - * 'Tcl_GetCurrentThread' API. + * Implements the "testTclStatProc" cmd that is used to test the + * 'TclStatInsertProc' & 'TclStatDeleteProc' C Apis. * * Results: * A standard Tcl result. @@ -5049,21 +5160,214 @@ TestsaveresultFree( */ static int -TestmainthreadCmd( +TeststatprocCmd( ClientData dummy, /* Not used. */ register Tcl_Interp *interp,/* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { - if (argc == 1) { - Tcl_Obj *idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread()); + TclStatProc_ *proc; + int retVal; - Tcl_SetObjResult(interp, idObj); - return TCL_OK; + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " option arg\"", NULL); + return TCL_ERROR; + } + + if (strcmp(argv[2], "TclpStat") == 0) { + proc = PretendTclpStat; + } else if (strcmp(argv[2], "TestStatProc1") == 0) { + proc = TestStatProc1; + } else if (strcmp(argv[2], "TestStatProc2") == 0) { + proc = TestStatProc2; + } else if (strcmp(argv[2], "TestStatProc3") == 0) { + proc = TestStatProc3; } else { - Tcl_SetResult(interp, "wrong # args", TCL_STATIC); + Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": " + "must be TclpStat, " + "TestStatProc1, TestStatProc2, or TestStatProc3", NULL); + return TCL_ERROR; + } + + if (strcmp(argv[1], "insert") == 0) { + if (proc == PretendTclpStat) { + Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": " + "must be " + "TestStatProc1, TestStatProc2, or TestStatProc3", NULL); + return TCL_ERROR; + } + retVal = TclStatInsertProc(proc); + } else if (strcmp(argv[1], "delete") == 0) { + retVal = TclStatDeleteProc(proc); + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], "\": " + "must be insert or delete", NULL); return TCL_ERROR; } + + if (retVal == TCL_ERROR) { + Tcl_AppendResult(interp, "\"", argv[2], "\": " + "could not be ", argv[1], "ed", NULL); + } + + return retVal; +} + +static int +PretendTclpStat( + const char *path, + struct stat *buf) +{ + int ret; + Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1); +#ifdef TCL_WIDE_INT_IS_LONG + Tcl_IncrRefCount(pathPtr); + ret = TclpObjStat(pathPtr, buf); + Tcl_DecrRefCount(pathPtr); + return ret; +#else /* TCL_WIDE_INT_IS_LONG */ + Tcl_StatBuf realBuf; + Tcl_IncrRefCount(pathPtr); + ret = TclpObjStat(pathPtr, &realBuf); + Tcl_DecrRefCount(pathPtr); + if (ret != -1) { +# define OUT_OF_RANGE(x) \ + (((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \ + ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX)) +#if defined(__GNUC__) && __GNUC__ >= 2 +/* + * Workaround gcc warning of "comparison is always false due to limited range of + * data type" in this macro by checking max type size, and when necessary ANDing + * with the complement of ULONG_MAX instead of the comparison: + */ +# define OUT_OF_URANGE(x) \ + ((((Tcl_WideUInt)(~ (__typeof__(x)) 0)) > (Tcl_WideUInt)ULONG_MAX) && \ + (((Tcl_WideUInt)(x)) & ~(Tcl_WideUInt)ULONG_MAX)) +#else +# define OUT_OF_URANGE(x) \ + (((Tcl_WideUInt)(x)) > (Tcl_WideUInt)ULONG_MAX) +#endif + + /* + * Perform the result-buffer overflow check manually. + * + * Note that ino_t/ino64_t is unsigned... + */ + + if (OUT_OF_URANGE(realBuf.st_ino) || OUT_OF_RANGE(realBuf.st_size) +# ifdef HAVE_STRUCT_STAT_ST_BLOCKS + || OUT_OF_RANGE(realBuf.st_blocks) +# endif + ) { +# ifdef EOVERFLOW + errno = EOVERFLOW; +# else +# ifdef EFBIG + errno = EFBIG; +# else +# error "what error should be returned for a value out of range?" +# endif +# endif + return -1; + } + +# undef OUT_OF_RANGE +# 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... + */ + + buf->st_mode = realBuf.st_mode; + buf->st_ino = (ino_t) realBuf.st_ino; + buf->st_dev = realBuf.st_dev; + buf->st_rdev = realBuf.st_rdev; + buf->st_nlink = realBuf.st_nlink; + buf->st_uid = realBuf.st_uid; + buf->st_gid = realBuf.st_gid; + buf->st_size = (off_t) realBuf.st_size; + buf->st_atime = realBuf.st_atime; + buf->st_mtime = realBuf.st_mtime; + buf->st_ctime = realBuf.st_ctime; +# ifdef HAVE_STRUCT_STAT_ST_BLKSIZE + buf->st_blksize = realBuf.st_blksize; +# endif +# ifdef HAVE_STRUCT_STAT_ST_BLOCKS + buf->st_blocks = (blkcnt_t) realBuf.st_blocks; +# endif + } + return ret; +#endif /* TCL_WIDE_INT_IS_LONG */ +} + +static int +TestStatProc1( + const char *path, + struct stat *buf) +{ + memset(buf, 0, sizeof(struct stat)); + buf->st_size = 1234; + return ((strstr(path, "testStat1%.fil") == NULL) ? -1 : 0); +} + +static int +TestStatProc2( + const char *path, + struct stat *buf) +{ + memset(buf, 0, sizeof(struct stat)); + buf->st_size = 2345; + return ((strstr(path, "testStat2%.fil") == NULL) ? -1 : 0); +} + +static int +TestStatProc3( + const char *path, + struct stat *buf) +{ + memset(buf, 0, sizeof(struct stat)); + buf->st_size = 3456; + return ((strstr(path, "testStat3%.fil") == NULL) ? -1 : 0); +} +#endif + +/* + *---------------------------------------------------------------------- + * + * TestmainthreadCmd -- + * + * Implements the "testmainthread" cmd that is used to test the + * 'Tcl_GetCurrentThread' API. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestmainthreadCmd( + ClientData dummy, /* Not used. */ + register Tcl_Interp *interp,/* Current interpreter. */ + int argc, /* Number of arguments. */ + const char **argv) /* Argument strings. */ +{ + if (argc == 1) { + Tcl_Obj *idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread()); + Tcl_SetObjResult(interp, idObj); + return TCL_OK; + } else { + Tcl_SetResult(interp, "wrong # args", TCL_STATIC); + return TCL_ERROR; + } } /* @@ -5074,7 +5378,7 @@ TestmainthreadCmd( * A main loop set by TestsetmainloopCmd below. * * Results: - * None. + * None. * * Side effects: * Event handlers could do anything. @@ -5113,7 +5417,7 @@ static int TestsetmainloopCmd( ClientData dummy, /* Not used. */ register Tcl_Interp *interp,/* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { exitMainLoop = 0; @@ -5142,12 +5446,315 @@ static int TestexitmainloopCmd( ClientData dummy, /* Not used. */ register Tcl_Interp *interp,/* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { exitMainLoop = 1; return TCL_OK; } +#ifdef USE_OBSOLETE_FS_HOOKS + +/* + *---------------------------------------------------------------------- + * + * TestaccessprocCmd -- + * + * Implements the "testTclAccessProc" cmd that is used to test the + * 'TclAccessInsertProc' & 'TclAccessDeleteProc' C Apis. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestaccessprocCmd( + ClientData dummy, /* Not used. */ + register Tcl_Interp *interp,/* Current interpreter. */ + int argc, /* Number of arguments. */ + const char **argv) /* Argument strings. */ +{ + TclAccessProc_ *proc; + int retVal; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " option arg\"", NULL); + return TCL_ERROR; + } + + if (strcmp(argv[2], "TclpAccess") == 0) { + proc = PretendTclpAccess; + } else if (strcmp(argv[2], "TestAccessProc1") == 0) { + proc = TestAccessProc1; + } else if (strcmp(argv[2], "TestAccessProc2") == 0) { + proc = TestAccessProc2; + } else if (strcmp(argv[2], "TestAccessProc3") == 0) { + proc = TestAccessProc3; + } else { + Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": " + "must be TclpAccess, " + "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 " + "TestAccessProc1, TestAccessProc2, or TestAccessProc3" + NULL); + return TCL_ERROR; + } + retVal = TclAccessInsertProc(proc); + } else if (strcmp(argv[1], "delete") == 0) { + retVal = TclAccessDeleteProc(proc); + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], "\": " + "must be insert or delete", NULL); + return TCL_ERROR; + } + + if (retVal == TCL_ERROR) { + Tcl_AppendResult(interp, "\"", argv[2], "\": " + "could not be ", argv[1], "ed", NULL); + } + + return retVal; +} + +static int +PretendTclpAccess( + const char *path, + int mode) +{ + int ret; + Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1); + Tcl_IncrRefCount(pathPtr); + ret = TclpObjAccess(pathPtr, mode); + Tcl_DecrRefCount(pathPtr); + return ret; +} + +static int +TestAccessProc1( + const char *path, + int mode) +{ + return ((strstr(path, "testAccess1%.fil") == NULL) ? -1 : 0); +} + +static int +TestAccessProc2( + const char *path, + int mode) +{ + return ((strstr(path, "testAccess2%.fil") == NULL) ? -1 : 0); +} + +static int +TestAccessProc3( + const char *path, + int mode) +{ + return ((strstr(path, "testAccess3%.fil") == NULL) ? -1 : 0); +} + +/* + *---------------------------------------------------------------------- + * + * TestopenfilechannelprocCmd -- + * + * Implements the "testTclOpenFileChannelProc" cmd that is used to test + * the 'TclOpenFileChannelInsertProc' & 'TclOpenFileChannelDeleteProc' C + * Apis. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestopenfilechannelprocCmd( + ClientData dummy, /* Not used. */ + register Tcl_Interp *interp,/* Current interpreter. */ + int argc, /* Number of arguments. */ + const char **argv) /* Argument strings. */ +{ + TclOpenFileChannelProc_ *proc; + int retVal; + + if (argc != 3) { + Tcl_AppendResult(interp, "wrong # args: should be \"", + argv[0], " option arg\"", NULL); + return TCL_ERROR; + } + + if (strcmp(argv[2], "TclpOpenFileChannel") == 0) { + proc = PretendTclpOpenFileChannel; + } else if (strcmp(argv[2], "TestOpenFileChannelProc1") == 0) { + proc = TestOpenFileChannelProc1; + } else if (strcmp(argv[2], "TestOpenFileChannelProc2") == 0) { + proc = TestOpenFileChannelProc2; + } else if (strcmp(argv[2], "TestOpenFileChannelProc3") == 0) { + proc = TestOpenFileChannelProc3; + } else { + Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": " + "must be TclpOpenFileChannel, " + "TestOpenFileChannelProc1, TestOpenFileChannelProc2, or " + "TestOpenFileChannelProc3", NULL); + return TCL_ERROR; + } + + if (strcmp(argv[1], "insert") == 0) { + if (proc == PretendTclpOpenFileChannel) { + Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": " + "must be " + "TestOpenFileChannelProc1, TestOpenFileChannelProc2, or " + "TestOpenFileChannelProc3", NULL); + return TCL_ERROR; + } + retVal = TclOpenFileChannelInsertProc(proc); + } else if (strcmp(argv[1], "delete") == 0) { + retVal = TclOpenFileChannelDeleteProc(proc); + } else { + Tcl_AppendResult(interp, "bad option \"", argv[1], "\": " + "must be insert or delete", NULL); + return TCL_ERROR; + } + + if (retVal == TCL_ERROR) { + Tcl_AppendResult(interp, "\"", argv[2], "\": " + "could not be ", argv[1], "ed", NULL); + } + + return retVal; +} + +static Tcl_Channel +PretendTclpOpenFileChannel( + Tcl_Interp *interp, /* Interpreter for error reporting; can be + * NULL. */ + const char *fileName, /* Name of file to open. */ + const char *modeString, /* A list of POSIX open modes or + * a string such as "rw". */ + int permissions) /* If the open involves creating a file, with + * what modes to create it? */ +{ + Tcl_Channel ret; + int mode, seekFlag; + Tcl_Obj *pathPtr; + mode = TclGetOpenMode(interp, modeString, &seekFlag); + if (mode == -1) { + return NULL; + } + pathPtr = Tcl_NewStringObj(fileName, -1); + Tcl_IncrRefCount(pathPtr); + ret = TclpOpenFileChannel(interp, pathPtr, mode, permissions); + Tcl_DecrRefCount(pathPtr); + if (ret != NULL) { + if (seekFlag) { + if (Tcl_Seek(ret, (Tcl_WideInt)0, SEEK_END) < (Tcl_WideInt)0) { + if (interp != NULL) { + Tcl_AppendResult(interp, + "could not seek to end of file while opening \"", + fileName, "\": ", Tcl_PosixError(interp), NULL); + } + Tcl_Close(NULL, ret); + return NULL; + } + } + } + return ret; +} + +static Tcl_Channel +TestOpenFileChannelProc1( + Tcl_Interp *interp, /* Interpreter for error reporting; can be + * NULL. */ + const char *fileName, /* Name of file to open. */ + const char *modeString, /* A list of POSIX open modes or + * a string such as "rw". */ + int permissions) /* If the open involves creating a file, with + * what modes to create it? */ +{ + const char *expectname = "testOpenFileChannel1%.fil"; + Tcl_DString ds; + + Tcl_DStringInit(&ds); + Tcl_JoinPath(1, &expectname, &ds); + + if (!strcmp(Tcl_DStringValue(&ds), fileName)) { + Tcl_DStringFree(&ds); + return (PretendTclpOpenFileChannel(interp, + "__testOpenFileChannel1%__.fil", + modeString, permissions)); + } else { + Tcl_DStringFree(&ds); + return NULL; + } +} + +static Tcl_Channel +TestOpenFileChannelProc2( + Tcl_Interp *interp, /* Interpreter for error reporting; can be + * NULL. */ + const char *fileName, /* Name of file to open. */ + const char *modeString, /* A list of POSIX open modes or + * a string such as "rw". */ + int permissions) /* If the open involves creating a file, with + * what modes to create it? */ +{ + const char *expectname = "testOpenFileChannel2%.fil"; + Tcl_DString ds; + + Tcl_DStringInit(&ds); + Tcl_JoinPath(1, &expectname, &ds); + + if (!strcmp(Tcl_DStringValue(&ds), fileName)) { + Tcl_DStringFree(&ds); + return (PretendTclpOpenFileChannel(interp, + "__testOpenFileChannel2%__.fil", + modeString, permissions)); + } else { + Tcl_DStringFree(&ds); + return (NULL); + } +} + +static Tcl_Channel +TestOpenFileChannelProc3( + Tcl_Interp *interp, /* Interpreter for error reporting; can be + * NULL. */ + const char *fileName, /* Name of file to open. */ + const char *modeString, /* A list of POSIX open modes or a string such + * as "rw". */ + int permissions) /* If the open involves creating a file, with + * what modes to create it? */ +{ + const char *expectname = "testOpenFileChannel3%.fil"; + Tcl_DString ds; + + Tcl_DStringInit(&ds); + Tcl_JoinPath(1, &expectname, &ds); + + if (!strcmp(Tcl_DStringValue(&ds), fileName)) { + Tcl_DStringFree(&ds); + return (PretendTclpOpenFileChannel(interp, "__testOpenFileChannel3%__.fil", + modeString, permissions)); + } else { + Tcl_DStringFree(&ds); + return (NULL); + } +} +#endif /* *---------------------------------------------------------------------- @@ -5171,7 +5778,7 @@ static int TestChannelCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Interpreter for result. */ - size_t argc, /* Count of additional args. */ + int argc, /* Count of additional args. */ const char **argv) /* Additional arg strings. */ { const char *cmdName; /* Sub command. */ @@ -5213,7 +5820,7 @@ TestChannelCmd( *nextPtrPtr = curPtr->nextPtr; curPtr->nextPtr = NULL; chan = curPtr->chan; - ckfree(curPtr); + ckfree((char *) curPtr); break; } } @@ -5235,7 +5842,7 @@ TestChannelCmd( if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerror", len) == 0)) { - Tcl_Obj *msg = Tcl_NewStringObj(argv[3], TCL_STRLEN); + Tcl_Obj *msg = Tcl_NewStringObj(argv[3],-1); Tcl_IncrRefCount(msg); Tcl_SetChannelError(chan, msg); @@ -5248,7 +5855,7 @@ TestChannelCmd( } if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerrorinterp", len) == 0)) { - Tcl_Obj *msg = Tcl_NewStringObj(argv[3], TCL_STRLEN); + Tcl_Obj *msg = Tcl_NewStringObj(argv[3],-1); Tcl_IncrRefCount(msg); Tcl_SetChannelErrorInterp(interp, msg); @@ -5283,7 +5890,7 @@ TestChannelCmd( /* Remember the channel in the pool of detached channels */ - det = ckalloc(sizeof(TestChannel)); + det = (TestChannel *) ckalloc(sizeof(TestChannel)); det->chan = chan; det->nextPtr = firstDetached; firstDetached = det; @@ -5453,7 +6060,7 @@ TestChannelCmd( return TCL_ERROR; } - TclFormatInt(buf, (size_t) Tcl_GetChannelThread(chan)); + TclFormatInt(buf, (long)(size_t)Tcl_GetChannelThread(chan)); Tcl_AppendResult(interp, buf, NULL); return TCL_OK; } @@ -5596,7 +6203,7 @@ TestChannelCmd( } return TclChannelTransform(interp, chan, - Tcl_NewStringObj(argv[4], TCL_STRLEN)); + Tcl_NewStringObj(argv[4], -1)); } if ((cmdName[0] == 'u') && (strncmp(cmdName, "unstack", len) == 0)) { @@ -5640,7 +6247,7 @@ static int TestChannelEventCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_Obj *resultListPtr; @@ -5681,14 +6288,15 @@ TestChannelEventCmd( return TCL_ERROR; } - esPtr = ckalloc(sizeof(EventScriptRecord)); + esPtr = (EventScriptRecord *) ckalloc((unsigned) + sizeof(EventScriptRecord)); esPtr->nextPtr = statePtr->scriptRecordPtr; statePtr->scriptRecordPtr = esPtr; esPtr->chanPtr = chanPtr; esPtr->interp = interp; esPtr->mask = mask; - esPtr->scriptPtr = Tcl_NewStringObj(argv[4], TCL_STRLEN); + esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1); Tcl_IncrRefCount(esPtr->scriptPtr); Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask, @@ -5738,7 +6346,7 @@ TestChannelEventCmd( Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, (ClientData) esPtr); Tcl_DecrRefCount(esPtr->scriptPtr); - ckfree(esPtr); + ckfree((char *) esPtr); return TCL_OK; } @@ -5755,11 +6363,10 @@ TestChannelEventCmd( esPtr = esPtr->nextPtr) { if (esPtr->mask) { Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj( - (esPtr->mask == TCL_READABLE) ? "readable" : "writable", - TCL_STRLEN)); + (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1)); } else { Tcl_ListObjAppendElement(interp, resultListPtr, - Tcl_NewStringObj("none", TCL_STRLEN)); + Tcl_NewStringObj("none", -1)); } Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr); } @@ -5780,7 +6387,7 @@ TestChannelEventCmd( Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr, TclChannelEventScriptInvoker, (ClientData) esPtr); Tcl_DecrRefCount(esPtr->scriptPtr); - ckfree(esPtr); + ckfree((char *) esPtr); } statePtr->scriptRecordPtr = NULL; return TCL_OK; @@ -5852,12 +6459,11 @@ static int TestWrongNumArgsObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i; - size_t length; - const char *msg; + int i, length; + char *msg; if (objc < 3) { /* @@ -5877,7 +6483,7 @@ TestWrongNumArgsObjCmd( msg = NULL; } - if ((size_t) i > objc - 3) { + if (i > objc - 3) { /* * Asked for more arguments than were given. */ @@ -5909,10 +6515,10 @@ static int TestGetIndexFromObjStructObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - const char *const ary[] = { + const char *ary[] = { "a", "b", "c", "d", "e", "f", NULL, NULL }; int idx,target; @@ -5963,11 +6569,11 @@ static int TestFilesystemObjCmd( ClientData dummy, Tcl_Interp *interp, - size_t objc, + int objc, Tcl_Obj *const objv[]) { int res, boolVal; - const char *msg; + char *msg; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "boolean"); @@ -5983,7 +6589,7 @@ TestFilesystemObjCmd( res = Tcl_FSUnregister(&testReportingFilesystem); msg = (res == TCL_OK) ? "unregistered" : "failed"; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , TCL_STRLEN)); + Tcl_SetResult(interp, msg, TCL_VOLATILE); return res; } @@ -6070,7 +6676,7 @@ TestReport( Tcl_DString ds; Tcl_DStringInit(&ds); - Tcl_DStringAppend(&ds, "lappend filesystemReport ", TCL_STRLEN); + Tcl_DStringAppend(&ds, "lappend filesystemReport ", -1); Tcl_DStringStartSublist(&ds); Tcl_DStringAppendElement(&ds, cmd); if (path != NULL) { @@ -6249,7 +6855,7 @@ TestReportRemoveDirectory( errorPtr); } -static const char *const * +static const char ** TestReportFileAttrStrings( Tcl_Obj *fileName, Tcl_Obj **objPtrRef) @@ -6335,11 +6941,11 @@ static int TestSimpleFilesystemObjCmd( ClientData dummy, Tcl_Interp *interp, - size_t objc, + int objc, Tcl_Obj *const objv[]) { int res, boolVal; - const char *msg; + char *msg; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "boolean"); @@ -6355,7 +6961,7 @@ TestSimpleFilesystemObjCmd( res = Tcl_FSUnregister(&simpleFilesystem); msg = (res == TCL_OK) ? "unregistered" : "failed"; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , TCL_STRLEN)); + Tcl_SetResult(interp, msg, TCL_VOLATILE); return res; } @@ -6368,7 +6974,7 @@ static Tcl_Obj * SimpleRedirect( Tcl_Obj *pathPtr) /* Name of file to copy. */ { - size_t len; + int len; const char *str; Tcl_Obj *origPtr; @@ -6382,7 +6988,7 @@ SimpleRedirect( Tcl_IncrRefCount(pathPtr); return pathPtr; } - origPtr = Tcl_NewStringObj(str+10, TCL_STRLEN); + origPtr = Tcl_NewStringObj(str+10,-1); Tcl_IncrRefCount(origPtr); return origPtr; } @@ -6414,14 +7020,12 @@ SimpleMatchInDirectory( origPtr = SimpleRedirect(dirPtr); res = Tcl_FSMatchInDirectory(interp, resPtr, origPtr, pattern, types); if (res == TCL_OK) { - size_t gLength, j; - + int gLength, j; Tcl_ListObjLength(NULL, resPtr, &gLength); for (j = 0; j < gLength; j++) { Tcl_Obj *gElt, *nElt; - Tcl_ListObjIndex(NULL, resPtr, j, &gElt); - nElt = Tcl_NewStringObj("simplefs:/", 10); + nElt = Tcl_NewStringObj("simplefs:/",10); Tcl_AppendObjToObj(nElt, gElt); Tcl_ListObjAppendElement(NULL, resultPtr, nElt); } @@ -6484,7 +7088,7 @@ SimpleListVolumes(void) /* Add one new volume */ Tcl_Obj *retVal; - retVal = Tcl_NewStringObj("simplefs:/", TCL_STRLEN); + retVal = Tcl_NewStringObj("simplefs:/", -1); Tcl_IncrRefCount(retVal); return retVal; } @@ -6497,11 +7101,11 @@ static int TestNumUtfCharsCmd( ClientData clientData, Tcl_Interp *interp, - size_t objc, + int objc, Tcl_Obj *const objv[]) { if (objc > 1) { - size_t len = TCL_STRLEN; + int len = -1; if (objc > 2) { (void) Tcl_GetStringFromObj(objv[1], &len); @@ -6540,7 +7144,7 @@ static int TestcpuidCmd( ClientData dummy, Tcl_Interp* interp, /* Tcl interpreter */ - size_t objc, /* Parameter count */ + int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ { int status, index, i; @@ -6557,7 +7161,7 @@ TestcpuidCmd( status = TclWinCPUID((unsigned) index, regs); if (status != TCL_OK) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("operation not available", TCL_STRLEN)); + Tcl_NewStringObj("operation not available", -1)); return status; } for (i=0 ; i<4 ; ++i) { @@ -6576,10 +7180,10 @@ static int TestHashSystemHashCmd( ClientData clientData, Tcl_Interp *interp, - size_t objc, + int objc, Tcl_Obj *const objv[]) { - static const Tcl_HashKeyType hkType = { + static Tcl_HashKeyType hkType = { TCL_HASH_KEY_TYPE_VERSION, TCL_HASH_KEY_SYSTEM_HASH, NULL, NULL, NULL, NULL }; @@ -6600,15 +7204,14 @@ TestHashSystemHashCmd( } for (i=0 ; i<limit ; i++) { - hPtr = Tcl_CreateHashEntry(&hash, INT2PTR(i), &isNew); + hPtr = Tcl_CreateHashEntry(&hash, (char *) INT2PTR(i), &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_NewIntObj(i)); - Tcl_AppendToObj(Tcl_GetObjResult(interp), " creation problem", - TCL_STRLEN); + Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem",-1); Tcl_DeleteHashTable(&hash); return TCL_ERROR; } - Tcl_SetHashValue(hPtr, INT2PTR(i+42)); + Tcl_SetHashValue(hPtr, (ClientData) INT2PTR(i+42)); } if (hash.numEntries != limit) { @@ -6621,15 +7224,13 @@ TestHashSystemHashCmd( hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i)); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewIntObj(i)); - Tcl_AppendToObj(Tcl_GetObjResult(interp), " lookup problem", - TCL_STRLEN); + Tcl_AppendToObj(Tcl_GetObjResult(interp)," lookup problem",-1); Tcl_DeleteHashTable(&hash); return TCL_ERROR; } if (PTR2INT(Tcl_GetHashValue(hPtr)) != i+42) { Tcl_SetObjResult(interp, Tcl_NewIntObj(i)); - Tcl_AppendToObj(Tcl_GetObjResult(interp), " value problem", - TCL_STRLEN); + Tcl_AppendToObj(Tcl_GetObjResult(interp)," value problem",-1); Tcl_DeleteHashTable(&hash); return TCL_ERROR; } @@ -6655,7 +7256,7 @@ static int TestgetintCmd( ClientData dummy, Tcl_Interp *interp, - size_t argc, + int argc, const char **argv) { if (argc < 2) { @@ -6663,6 +7264,7 @@ TestgetintCmd( return TCL_ERROR; } else { int val, i, total=0; + char buf[TCL_INTEGER_SPACE]; for (i=1 ; i<argc ; i++) { if (Tcl_GetInt(interp, argv[i], &val) != TCL_OK) { @@ -6670,48 +7272,12 @@ TestgetintCmd( } total += val; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(total)); + TclFormatInt(buf, total); + Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_OK; } } -static int -TestNRELevels( - ClientData clientData, - Tcl_Interp *interp, - size_t objc, - Tcl_Obj *const objv[]) -{ - Interp *iPtr = (Interp *) interp; - static ptrdiff_t *refDepth = NULL; - ptrdiff_t depth; - Tcl_Obj *levels[6]; - int i = 0; - NRE_callback *cbPtr = iPtr->execEnvPtr->callbackPtr; - - if (refDepth == NULL) { - refDepth = &depth; - } - - depth = (refDepth - &depth); - - levels[0] = Tcl_NewIntObj(depth); - levels[1] = Tcl_NewIntObj(iPtr->numLevels); - levels[2] = Tcl_NewIntObj(iPtr->cmdFramePtr->level); - levels[3] = Tcl_NewIntObj(iPtr->varFramePtr->level); - levels[4] = Tcl_NewIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr - - iPtr->execEnvPtr->execStackPtr->stackWords); - - while (cbPtr) { - i++; - cbPtr = cbPtr->nextPtr; - } - levels[5] = Tcl_NewIntObj(i); - - Tcl_SetObjResult(interp, Tcl_NewListObj(6, levels)); - return TCL_OK; -} - /* *---------------------------------------------------------------------- * @@ -6735,12 +7301,11 @@ static int TestconcatobjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t argc, /* Number of arguments. */ + int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { Tcl_Obj *list1Ptr, *list2Ptr, *emptyPtr, *concatPtr, *tmpPtr; - int result = TCL_OK; - size_t len; + int result = TCL_OK, len; Tcl_Obj *objv[3]; /* @@ -6749,21 +7314,21 @@ TestconcatobjCmd( */ Tcl_SetObjResult(interp, - Tcl_NewStringObj("Tcl_ConcatObj is unsafe:", TCL_STRLEN)); + Tcl_NewStringObj("Tcl_ConcatObj is unsafe:", -1)); emptyPtr = Tcl_NewObj(); - list1Ptr = Tcl_NewStringObj("foo bar sum", TCL_STRLEN); + list1Ptr = Tcl_NewStringObj("foo bar sum", -1); Tcl_ListObjLength(NULL, list1Ptr, &len); if (list1Ptr->bytes != NULL) { - ckfree(list1Ptr->bytes); + ckfree((char *) list1Ptr->bytes); list1Ptr->bytes = NULL; } - list2Ptr = Tcl_NewStringObj("eeny meeny", TCL_STRLEN); + list2Ptr = Tcl_NewStringObj("eeny meeny", -1); Tcl_ListObjLength(NULL, list2Ptr, &len); if (list2Ptr->bytes != NULL) { - ckfree(list2Ptr->bytes); + ckfree((char *) list2Ptr->bytes); list2Ptr->bytes = NULL; } @@ -6909,7 +7474,7 @@ TestconcatobjCmd( "\n\t* (e) concatObj does not have refCount 0", NULL); } if (concatPtr == tmpPtr) { - size_t len; + int len; result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (e) concatObj is not a new obj ", @@ -6941,7 +7506,7 @@ TestconcatobjCmd( "\n\t* (f) concatObj does not have refCount 0", NULL); } if (concatPtr == tmpPtr) { - size_t len; + int len; result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (f) concatObj is not a new obj ", @@ -6974,7 +7539,7 @@ TestconcatobjCmd( "\n\t* (g) concatObj does not have refCount 0", NULL); } if (concatPtr == tmpPtr) { - size_t len; + int len; result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (g) concatObj is not a new obj ", @@ -7018,240 +7583,6 @@ TestconcatobjCmd( } /* - *---------------------------------------------------------------------- - * - * TestparseargsCmd -- - * - * This procedure implements the "testparseargs" command. It is used to - * test that Tcl_ParseArgsObjv does indeed return the right number of - * arguments. In other words, that [Bug 3413857] was fixed properly. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestparseargsCmd( - ClientData dummy, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Arguments. */ -{ - static int foo = 0; - size_t count = objc; - Tcl_Obj **remObjv, *result[3]; - Tcl_ArgvInfo argTable[] = { - {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL}, - TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END - }; - - foo = 0; - if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) { - return TCL_ERROR; - } - result[0] = Tcl_NewIntObj(foo); - result[1] = Tcl_NewIntObj((int) count); - result[2] = Tcl_NewListObj(count, remObjv); - Tcl_SetObjResult(interp, Tcl_NewListObj(3, result)); - ckfree(remObjv); - return TCL_OK; -} - -/** - * Test harness for command and variable resolvers. - */ - -static int -InterpCmdResolver( - Tcl_Interp *interp, - const char *name, - Tcl_Namespace *context, - int flags, - Tcl_Command *rPtr) -{ - Interp *iPtr = (Interp *) interp; - CallFrame *varFramePtr = iPtr->varFramePtr; - Proc *procPtr = (varFramePtr->isProcCallFrame & FRAME_IS_PROC) ? - varFramePtr->procPtr : NULL; - Namespace *ns2NsPtr = (Namespace *) - Tcl_FindNamespace(interp, "::ns2", NULL, 0); - - if (procPtr && (procPtr->cmdPtr->nsPtr == iPtr->globalNsPtr - || (ns2NsPtr && procPtr->cmdPtr->nsPtr == ns2NsPtr))) { - const char *callingCmdName = - Tcl_GetCommandName(interp, (Tcl_Command) procPtr->cmdPtr); - - if ((callingCmdName[0] == 'x') && (callingCmdName[1] == '\0') - && (name[0] == 'z') && (name[1] == '\0')) { - Tcl_Command sourceCmdPtr = Tcl_FindCommand(interp, "y", NULL, - TCL_GLOBAL_ONLY); - - if (sourceCmdPtr != NULL) { - *rPtr = sourceCmdPtr; - return TCL_OK; - } - } - } - return TCL_CONTINUE; -} - -static int -InterpVarResolver( - Tcl_Interp *interp, - const char *name, - Tcl_Namespace *context, - int flags, - Tcl_Var *rPtr) -{ - /* - * Don't resolve the variable; use standard rules. - */ - - return TCL_CONTINUE; -} - -typedef struct MyResolvedVarInfo { - Tcl_ResolvedVarInfo vInfo; /* This must be the first element. */ - Tcl_Var var; - Tcl_Obj *nameObj; -} MyResolvedVarInfo; - -static inline void -HashVarFree( - Tcl_Var var) -{ - if (VarHashRefCount(var) < 2) { - ckfree(var); - } else { - VarHashRefCount(var)--; - } -} - -static void -MyCompiledVarFree( - Tcl_ResolvedVarInfo *vInfoPtr) -{ - MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *) vInfoPtr; - - Tcl_DecrRefCount(resVarInfo->nameObj); - if (resVarInfo->var) { - HashVarFree(resVarInfo->var); - } - ckfree(vInfoPtr); -} - -#define TclVarHashGetValue(hPtr) \ - ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry))) - -static Tcl_Var -MyCompiledVarFetch( - Tcl_Interp *interp, - Tcl_ResolvedVarInfo *vinfoPtr) -{ - MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *) vinfoPtr; - Tcl_Var var = resVarInfo->var; - int isNewVar; - Interp *iPtr = (Interp *) interp; - Tcl_HashEntry *hPtr; - - if (var != NULL) { - if (!(((Var *) var)->flags & VAR_DEAD_HASH)) { - /* - * The cached variable is valid, return it. - */ - - return var; - } - - /* - * The variable is not valid anymore. Clean it up. - */ - - HashVarFree(var); - } - - hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) &iPtr->globalNsPtr->varTable, - (char *) resVarInfo->nameObj, &isNewVar); - if (hPtr) { - var = (Tcl_Var) TclVarHashGetValue(hPtr); - } else { - var = NULL; - } - resVarInfo->var = var; - - /* - * Increment the reference counter to avoid ckfree() of the variable in - * Tcl's FreeVarEntry(); for cleanup, we provide our own HashVarFree(); - */ - - VarHashRefCount(var)++; - return var; -} - -static int -InterpCompiledVarResolver( - Tcl_Interp *interp, - const char *name, - size_t length, - Tcl_Namespace *context, - Tcl_ResolvedVarInfo **rPtr) -{ - if (*name == 'T') { - MyResolvedVarInfo *resVarInfo = ckalloc(sizeof(MyResolvedVarInfo)); - - resVarInfo->vInfo.fetchProc = MyCompiledVarFetch; - resVarInfo->vInfo.deleteProc = MyCompiledVarFree; - resVarInfo->var = NULL; - resVarInfo->nameObj = Tcl_NewStringObj(name, TCL_STRLEN); - Tcl_IncrRefCount(resVarInfo->nameObj); - *rPtr = &resVarInfo->vInfo; - return TCL_OK; - } - return TCL_CONTINUE; -} - -static int -TestInterpResolverCmd( - ClientData clientData, - Tcl_Interp *interp, - size_t objc, - Tcl_Obj *const objv[]) -{ - static const char *const table[] = { - "down", "up", NULL - }; - int idx; -#define RESOLVER_KEY "testInterpResolver" - - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "up|down"); - return TCL_ERROR; - } - if (Tcl_GetIndexFromObj(interp, objv[1], table, "operation", TCL_EXACT, - &idx) != TCL_OK) { - return TCL_ERROR; - } - switch (idx) { - case 1: /* up */ - Tcl_AddInterpResolvers(interp, RESOLVER_KEY, InterpCmdResolver, - InterpVarResolver, InterpCompiledVarResolver); - break; - case 0: /*down*/ - if (!Tcl_RemoveInterpResolvers(interp, RESOLVER_KEY)) { - Tcl_AppendResult(interp, "could not remove the resolver scheme", - NULL); - return TCL_ERROR; - } - } - return TCL_OK; -} - -/* * Local Variables: * mode: c * c-basic-offset: 4 |