From cacfaf16ecf05b44bacecbba3b2f673bf810e64c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 1 Jun 2022 19:34:43 +0000 Subject: TIP #627 implementation --- doc/CrtObjCmd.3 | 19 ++- doc/CrtTrace.3 | 10 +- doc/NRE.3 | 11 ++ generic/tcl.decls | 17 +++ generic/tcl.h | 12 ++ generic/tclBasic.c | 142 +++++++++++++++++++++- generic/tclDecls.h | 33 ++++++ generic/tclStubInit.c | 6 + generic/tclTest.c | 320 ++++++++++++++++++++++++++------------------------ generic/tclTestObj.c | 55 ++++----- generic/tclTrace.c | 44 +++++++ 11 files changed, 484 insertions(+), 185 deletions(-) diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3 index 8d10418..57834da 100644 --- a/doc/CrtObjCmd.3 +++ b/doc/CrtObjCmd.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj \- implement new commands in C +Tcl_CreateObjCommand, Tcl_CreateObjCommand2, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj \- implement new commands in C .SH SYNOPSIS .nf \fB#include \fR @@ -16,6 +16,9 @@ Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetComm Tcl_Command \fBTcl_CreateObjCommand\fR(\fIinterp, cmdName, proc, clientData, deleteProc\fR) .sp +Tcl_Command +\fBTcl_CreateObjCommand2\fR(\fIinterp, cmdName, proc2, clientData, deleteProc\fR) +.sp int \fBTcl_DeleteCommand\fR(\fIinterp, cmdName\fR) .sp @@ -52,6 +55,9 @@ Name of command. .AP Tcl_ObjCmdProc *proc in Implementation of the new command: \fIproc\fR will be called whenever \fIcmdName\fR is invoked as a command. +.AP Tcl_ObjCmdProc2 *proc2 in +Implementation of the new command: \fIproc2\fR will be called whenever +\fIcmdName\fR is invoked as a command. .AP ClientData clientData in Arbitrary one-word value to pass to \fIproc\fR and \fIdeleteProc\fR. .AP Tcl_CmdDeleteProc *deleteProc in @@ -174,6 +180,17 @@ typedef void \fBTcl_CmdDeleteProc\fR( The \fIclientData\fR argument will be the same as the \fIclientData\fR argument passed to \fBTcl_CreateObjCommand\fR. .PP +\fBTcl_CreateObjCommand2\fR does the same as \fBTcl_CreateObjCommand2\fR, +except its \fIproc2\fR argument is of type \fBTcl_ObjCmdProc2\fR(. +.PP +.CS +typedef int \fBTcl_ObjCmdProc2\fR( + ClientData \fIclientData\fR, + Tcl_Interp *\fIinterp\fR, + size_t \fIobjc\fR, + Tcl_Obj *const \fIobjv\fR[]); +.CE +.PP \fBTcl_DeleteCommand\fR deletes a command from a command interpreter. Once the call completes, attempts to invoke \fIcmdName\fR in \fIinterp\fR will result in errors. diff --git a/doc/CrtTrace.3 b/doc/CrtTrace.3 index 620c081..417c892 100644 --- a/doc/CrtTrace.3 +++ b/doc/CrtTrace.3 @@ -10,7 +10,7 @@ .so man.macros .BS .SH NAME -Tcl_CreateTrace, Tcl_CreateObjTrace, Tcl_DeleteTrace \- arrange for command execution to be traced +Tcl_CreateTrace, Tcl_CreateObjTrace, Tcl_CreateObjTrace2, Tcl_DeleteTrace \- arrange for command execution to be traced .SH SYNOPSIS .nf \fB#include \fR @@ -21,6 +21,9 @@ Tcl_Trace Tcl_Trace \fBTcl_CreateObjTrace\fR(\fIinterp, level, flags, objProc, clientData, deleteProc\fR) .sp +Tcl_Trace +\fBTcl_CreateObjTrace2\fR(\fIinterp, level, flags, objProc2, clientData, deleteProc\fR) +.sp \fBTcl_DeleteTrace\fR(\fIinterp, trace\fR) .SH ARGUMENTS .AS Tcl_CmdObjTraceDeleteProc *deleteProc @@ -38,11 +41,14 @@ Flags governing the trace execution. See below for details. .AP Tcl_CmdObjTraceProc *objProc in Procedure to call for each command that is executed. See below for details of the calling sequence. +.AP Tcl_CmdObjTraceProc2 *objProc2 in +Procedure to call for each command that is executed. See below for +details of the calling sequence. .AP Tcl_CmdTraceProc *proc in Procedure to call for each command that is executed. See below for details on the calling sequence. .AP ClientData clientData in -Arbitrary one-word value to pass to \fIobjProc\fR or \fIproc\fR. +Arbitrary one-word value to pass to \fIobjProc\fR, \fIobjProc2\fR or \fIproc\fR. .AP Tcl_CmdObjTraceDeleteProc *deleteProc in Procedure to call when the trace is deleted. See below for details of the calling sequence. A NULL pointer is permissible and results in no diff --git a/doc/NRE.3 b/doc/NRE.3 index 72bb370..f3e0735 100644 --- a/doc/NRE.3 +++ b/doc/NRE.3 @@ -18,6 +18,10 @@ Tcl_Command \fBTcl_NRCreateCommand\fR(\fIinterp, cmdName, proc, nreProc, clientData, deleteProc\fR) .sp +Tcl_Command +\fBTcl_NRCreateCommand2\fR(\fIinterp, cmdName, proc2, nreProc2, clientData, + deleteProc\fR) +.sp int \fBTcl_NRCallObjProc\fR(\fIinterp, nreProc, clientData, objc, objv\fR) .sp @@ -47,8 +51,12 @@ Called in order to evaluate a command. Is often just a small wrapper that uses \fBTcl_NRCallObjProc\fR to call \fInreProc\fR using a new trampoline. Behaves in the same way as the \fIproc\fR argument to \fBTcl_CreateObjCommand\fR(3) (\fIq.v.\fR). +.AP Tcl_ObjCmdProc2 *proc2 in +Same as \fIproc\fR, but handles more arguments. .AP Tcl_ObjCmdProc *nreProc in Called instead of \fIproc\fR when a trampoline is already in use. +.AP Tcl_ObjCmdProc2 *nreProc2 in +Called instead of \fIproc2\fR when a trampoline is already in use. .AP ClientData clientData in Arbitrary one-word value passed to \fIproc\fR, \fInreProc\fR, \fIdeleteProc\fR and \fIobjProc\fR. @@ -104,6 +112,9 @@ first deleted. If \fIinterp\fR is in the process of being deleted \fBTcl_NRCreateCommand\fR does not create any command, does not delete any command, and returns NULL. .PP +\fBTcl_NRCreateCommand2\fR, is an alternative to \fBTcl_CreateObjCommand2\fR +in the same way as fBTcl_NRCreateCommand\fR. +.PP \fBTcl_NREvalObj\fR pushes a function that is like \fBTcl_EvalObjEx\fR but consumes no space on the C stack. .PP diff --git a/generic/tcl.decls b/generic/tcl.decls index 309eeb4..c39be2a 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2470,6 +2470,23 @@ declare 673 { int TclGetUniChar(Tcl_Obj *objPtr, int index) } +declare 676 { + Tcl_Command Tcl_CreateObjCommand2(Tcl_Interp *interp, + const char *cmdName, + Tcl_ObjCmdProc2 *proc2, void *clientData, + Tcl_CmdDeleteProc *deleteProc) +} +declare 677 { + Tcl_Trace Tcl_CreateObjTrace2(Tcl_Interp *interp, int level, int flags, + Tcl_CmdObjTraceProc2 *objProc2, void *clientData, + Tcl_CmdObjTraceDeleteProc *delProc) +} +declare 679 { + Tcl_Command Tcl_NRCreateCommand2(Tcl_Interp *interp, + const char *cmdName, Tcl_ObjCmdProc2 *proc, + Tcl_ObjCmdProc2 *nreProc2, void *clientData, + Tcl_CmdDeleteProc *deleteProc) +} # ----- BASELINE -- FOR -- 8.7.0 ----- # diff --git a/generic/tcl.h b/generic/tcl.h index 274be35..886e42e 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -673,6 +673,9 @@ typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp, typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj *const *objv); +typedef int (Tcl_CmdObjTraceProc2) (void *clientData, Tcl_Interp *interp, + int level, const char *command, Tcl_Command commandInfo, size_t objc, + struct Tcl_Obj *const objv[]); typedef void (Tcl_CmdObjTraceDeleteProc) (ClientData clientData); typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr, struct Tcl_Obj *dupPtr); @@ -697,6 +700,8 @@ typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp, typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData); typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); +typedef int (Tcl_ObjCmdProc2) (void *clientData, Tcl_Interp *interp, + size_t objc, struct Tcl_Obj *const *objv); typedef int (Tcl_LibraryInitProc) (Tcl_Interp *interp); typedef int (Tcl_LibraryUnloadProc) (Tcl_Interp *interp, int flags); typedef void (Tcl_PanicProc) (const char *format, ...); @@ -916,6 +921,13 @@ typedef struct Tcl_CmdInfo { * change a command's namespace; use * TclRenameCommand or Tcl_Eval (of 'rename') * to do that. */ +#if (TCL_MAJOR_VERSION > 8) || defined(TCL_NO_DEPRECATED) + Tcl_ObjCmdProc2 *objProc2; /* Command's object-based function. */ + void *objClientData2; /* ClientData for object proc. */ +#else + void *reserved1; + void *reserved2; +#endif } Tcl_CmdInfo; /* diff --git a/generic/tclBasic.c b/generic/tclBasic.c index f87e1e1..c1dd8cb 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -2689,6 +2689,58 @@ Tcl_CreateCommand( *---------------------------------------------------------------------- */ +typedef struct { + void *clientData; /* Arbitrary value to pass to object function. */ + Tcl_ObjCmdProc2 *proc; + Tcl_CmdDeleteProc *deleteProc; +} CmdWrapperInfo; + + +static int cmdWrapperProc(void *clientData, + Tcl_Interp *interp, + int objc, + struct Tcl_Obj * const *objv) +{ + CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; + return info->proc(info->clientData, interp, objc, objv); +} + +static void cmdWrapperDeleteProc(void *clientData) { + CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; + + clientData = info->clientData; + Tcl_CmdDeleteProc *deleteProc = info->deleteProc; + Tcl_Free(info); + if (deleteProc != NULL) { + deleteProc(clientData); + } +} + +Tcl_Command +Tcl_CreateObjCommand2( + Tcl_Interp *interp, /* Token for command interpreter (returned by + * previous call to Tcl_CreateInterp). */ + const char *cmdName, /* Name of command. If it contains namespace + * qualifiers, the new command is put in the + * specified namespace; otherwise it is put in + * the global namespace. */ + Tcl_ObjCmdProc2 *proc, /* Object-based function to associate with + * name. */ + void *clientData, /* Arbitrary value to pass to object + * function. */ + Tcl_CmdDeleteProc *deleteProc + /* If not NULL, gives a function to call when + * this command is deleted. */ +) +{ + CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); + info->proc = proc; + info->deleteProc = deleteProc; + info->clientData = clientData; + + return Tcl_CreateObjCommand(interp, cmdName, cmdWrapperProc, info, cmdWrapperDeleteProc); +} + Tcl_Command Tcl_CreateObjCommand( Tcl_Interp *interp, /* Token for command interpreter (returned by @@ -3377,6 +3429,21 @@ Tcl_GetCommandInfo( *---------------------------------------------------------------------- */ +#if TCL_MAJOR_VERSION > 8 || defined(TCL_NO_DEPRECATED) +static int cmdWrapper2Proc(void *clientData, + Tcl_Interp *interp, + size_t objc, + Tcl_Obj *const objv[]) +{ + Command *cmdPtr = (Command *)clientData; + if (objc > INT_MAX) { + Tcl_WrongNumArgs(interp, 1, objv, "?args?"); + return TCL_ERROR; + } + return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); +} +#endif + int Tcl_GetCommandInfoFromToken( Tcl_Command cmd, @@ -3403,7 +3470,17 @@ Tcl_GetCommandInfoFromToken( infoPtr->deleteProc = cmdPtr->deleteProc; infoPtr->deleteData = cmdPtr->deleteData; infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr; - +#if TCL_MAJOR_VERSION > 8 || defined(TCL_NO_DEPRECATED) + if (infoPtr->objProc == cmdWrapperProc) { + CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->objClientData; + infoPtr->objProc2 = info->proc; + infoPtr->objClientData2 = info->clientData; + infoPtr->isNativeObjectProc = 2; + } else { + infoPtr->objProc2 = cmdWrapper2Proc; + infoPtr->objClientData2 = cmdPtr; + } +#endif return 1; } @@ -9125,6 +9202,69 @@ Tcl_NRCallObjProc( *---------------------------------------------------------------------- */ +typedef struct { + Tcl_ObjCmdProc2 *proc; + Tcl_ObjCmdProc2 *nreProc; + Tcl_CmdDeleteProc *delProc; + void *clientData; +} NRCommandWrapper; + +static int wrapperProc2( + void *clientData, + Tcl_Interp *interp, + int objc, + struct Tcl_Obj *const objv[]) +{ + NRCommandWrapper *wrapper = (NRCommandWrapper *)clientData; + return wrapper->proc(wrapper->clientData, interp, objc, objv); +} + +static int wrapperNRProc2( + void *clientData, + Tcl_Interp *interp, + int objc, + struct Tcl_Obj *const objv[]) +{ + NRCommandWrapper *wrapper = (NRCommandWrapper *)clientData; + return wrapper->nreProc(wrapper->clientData, interp, objc, objv); +} + +static void wrapperDelProc2(void *clientData) +{ + NRCommandWrapper *wrapper = (NRCommandWrapper *)clientData; + clientData = wrapper->clientData; + wrapper->delProc(clientData); + Tcl_Free(wrapper); +} + + +Tcl_Command +Tcl_NRCreateCommand2( + Tcl_Interp *interp, /* Token for command interpreter (returned by + * previous call to Tcl_CreateInterp). */ + const char *cmdName, /* Name of command. If it contains namespace + * qualifiers, the new command is put in the + * specified namespace; otherwise it is put in + * the global namespace. */ + Tcl_ObjCmdProc2 *proc, /* Object-based function to associate with + * name, provides direct access for direct + * calls. */ + Tcl_ObjCmdProc2 *nreProc, /* Object-based function to associate with + * name, provides NR implementation */ + void *clientData, /* Arbitrary value to pass to object + * function. */ + Tcl_CmdDeleteProc *deleteProc) + /* If not NULL, gives a function to call when + * this command is deleted. */ +{ + NRCommandWrapper *wrapper = (NRCommandWrapper *)Tcl_Alloc(sizeof(NRCommandWrapper)); + wrapper->proc = proc; + wrapper->nreProc = nreProc; + wrapper->delProc = deleteProc; + wrapper->clientData = clientData; + return Tcl_NRCreateCommand(interp, cmdName, wrapperProc2, wrapperNRProc2, wrapper, wrapperDelProc2); +} + Tcl_Command Tcl_NRCreateCommand( Tcl_Interp *interp, /* Token for command interpreter (returned by diff --git a/generic/tclDecls.h b/generic/tclDecls.h index ee9e02f..efc185a 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1974,6 +1974,24 @@ EXTERN const char * TclUtfAtIndex(const char *src, int index); EXTERN Tcl_Obj * TclGetRange(Tcl_Obj *objPtr, int first, int last); /* 673 */ EXTERN int TclGetUniChar(Tcl_Obj *objPtr, int index); +/* Slot 674 is reserved */ +/* Slot 675 is reserved */ +/* 676 */ +EXTERN Tcl_Command Tcl_CreateObjCommand2(Tcl_Interp *interp, + const char *cmdName, Tcl_ObjCmdProc2 *proc2, + void *clientData, + Tcl_CmdDeleteProc *deleteProc); +/* 677 */ +EXTERN Tcl_Trace Tcl_CreateObjTrace2(Tcl_Interp *interp, int level, + int flags, Tcl_CmdObjTraceProc2 *objProc2, + void *clientData, + Tcl_CmdObjTraceDeleteProc *delProc); +/* Slot 678 is reserved */ +/* 679 */ +EXTERN Tcl_Command Tcl_NRCreateCommand2(Tcl_Interp *interp, + const char *cmdName, Tcl_ObjCmdProc2 *proc, + Tcl_ObjCmdProc2 *nreProc2, void *clientData, + Tcl_CmdDeleteProc *deleteProc); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2683,6 +2701,12 @@ typedef struct TclStubs { const char * (*tclUtfAtIndex) (const char *src, int index); /* 671 */ Tcl_Obj * (*tclGetRange) (Tcl_Obj *objPtr, int first, int last); /* 672 */ int (*tclGetUniChar) (Tcl_Obj *objPtr, int index); /* 673 */ + void (*reserved674)(void); + void (*reserved675)(void); + Tcl_Command (*tcl_CreateObjCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 676 */ + Tcl_Trace (*tcl_CreateObjTrace2) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc2 *objProc2, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 677 */ + void (*reserved678)(void); + Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 679 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -4054,6 +4078,15 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tclGetRange) /* 672 */ #define TclGetUniChar \ (tclStubsPtr->tclGetUniChar) /* 673 */ +/* Slot 674 is reserved */ +/* Slot 675 is reserved */ +#define Tcl_CreateObjCommand2 \ + (tclStubsPtr->tcl_CreateObjCommand2) /* 676 */ +#define Tcl_CreateObjTrace2 \ + (tclStubsPtr->tcl_CreateObjTrace2) /* 677 */ +/* Slot 678 is reserved */ +#define Tcl_NRCreateCommand2 \ + (tclStubsPtr->tcl_NRCreateCommand2) /* 679 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index d34aff4..0f49f93 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1968,6 +1968,12 @@ const TclStubs tclStubs = { TclUtfAtIndex, /* 671 */ TclGetRange, /* 672 */ TclGetUniChar, /* 673 */ + 0, /* 674 */ + 0, /* 675 */ + Tcl_CreateObjCommand2, /* 676 */ + Tcl_CreateObjTrace2, /* 677 */ + 0, /* 678 */ + Tcl_NRCreateCommand2, /* 679 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclTest.c b/generic/tclTest.c index c740109..8502ccd 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -203,25 +203,25 @@ static int EncodingFromUtfProc(void *clientData, int *dstCharsPtr); static void ExitProcEven(void *clientData); static void ExitProcOdd(void *clientData); -static Tcl_ObjCmdProc GetTimesObjCmd; +static Tcl_ObjCmdProc2 GetTimesObjCmd; static Tcl_ResolveCompiledVarProc InterpCompiledVarResolver; static void MainLoop(void); static Tcl_CmdProc NoopCmd; -static Tcl_ObjCmdProc NoopObjCmd; +static Tcl_ObjCmdProc2 NoopObjCmd; static int ObjTraceProc(void *clientData, Tcl_Interp *interp, int level, const char *command, - Tcl_Command commandToken, int objc, + Tcl_Command commandToken, size_t objc, Tcl_Obj *const objv[]); static void ObjTraceDeleteProc(void *clientData); static void PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr); static void SpecialFree(char *blockPtr); static int StaticInitProc(Tcl_Interp *interp); static Tcl_CmdProc TestasyncCmd; -static Tcl_ObjCmdProc TestbumpinterpepochObjCmd; -static Tcl_ObjCmdProc TestbytestringObjCmd; -static Tcl_ObjCmdProc TestsetbytearraylengthObjCmd; -static Tcl_ObjCmdProc TestpurebytesobjObjCmd; -static Tcl_ObjCmdProc TeststringbytesObjCmd; +static Tcl_ObjCmdProc2 TestbumpinterpepochObjCmd; +static Tcl_ObjCmdProc2 TestbytestringObjCmd; +static Tcl_ObjCmdProc2 TestsetbytearraylengthObjCmd; +static Tcl_ObjCmdProc2 TestpurebytesobjObjCmd; +static Tcl_ObjCmdProc2 TeststringbytesObjCmd; static Tcl_CmdProc TestcmdinfoCmd; static Tcl_CmdProc TestcmdtokenCmd; static Tcl_CmdProc TestcmdtraceCmd; @@ -230,70 +230,70 @@ static Tcl_CmdProc TestcreatecommandCmd; static Tcl_CmdProc TestdcallCmd; static Tcl_CmdProc TestdelCmd; static Tcl_CmdProc TestdelassocdataCmd; -static Tcl_ObjCmdProc TestdoubledigitsObjCmd; +static Tcl_ObjCmdProc2 TestdoubledigitsObjCmd; static Tcl_CmdProc TestdstringCmd; -static Tcl_ObjCmdProc TestencodingObjCmd; -static Tcl_ObjCmdProc TestevalexObjCmd; -static Tcl_ObjCmdProc TestevalobjvObjCmd; -static Tcl_ObjCmdProc TesteventObjCmd; +static Tcl_ObjCmdProc2 TestencodingObjCmd; +static Tcl_ObjCmdProc2 TestevalexObjCmd; +static Tcl_ObjCmdProc2 TestevalobjvObjCmd; +static Tcl_ObjCmdProc2 TesteventObjCmd; static int TesteventProc(Tcl_Event *event, int flags); static int TesteventDeleteProc(Tcl_Event *event, void *clientData); static Tcl_CmdProc TestexithandlerCmd; static Tcl_CmdProc TestexprlongCmd; -static Tcl_ObjCmdProc TestexprlongobjCmd; +static Tcl_ObjCmdProc2 TestexprlongobjCmd; static Tcl_CmdProc TestexprdoubleCmd; -static Tcl_ObjCmdProc TestexprdoubleobjCmd; -static Tcl_ObjCmdProc TestexprparserObjCmd; +static Tcl_ObjCmdProc2 TestexprdoubleobjCmd; +static Tcl_ObjCmdProc2 TestexprparserObjCmd; static Tcl_CmdProc TestexprstringCmd; -static Tcl_ObjCmdProc TestfileCmd; -static Tcl_ObjCmdProc TestfilelinkCmd; +static Tcl_ObjCmdProc2 TestfileCmd; +static Tcl_ObjCmdProc2 TestfilelinkCmd; static Tcl_CmdProc TestfeventCmd; static Tcl_CmdProc TestgetassocdataCmd; static Tcl_CmdProc TestgetintCmd; static Tcl_CmdProc TestlongsizeCmd; static Tcl_CmdProc TestgetplatformCmd; -static Tcl_ObjCmdProc TestgetvarfullnameCmd; +static Tcl_ObjCmdProc2 TestgetvarfullnameCmd; static Tcl_CmdProc TestinterpdeleteCmd; static Tcl_CmdProc TestlinkCmd; -static Tcl_ObjCmdProc TestlinkarrayCmd; -static Tcl_ObjCmdProc TestlocaleCmd; +static Tcl_ObjCmdProc2 TestlinkarrayCmd; +static Tcl_ObjCmdProc2 TestlocaleCmd; static Tcl_CmdProc TestmainthreadCmd; static Tcl_CmdProc TestsetmainloopCmd; static Tcl_CmdProc TestexitmainloopCmd; static Tcl_CmdProc TestpanicCmd; -static Tcl_ObjCmdProc TestparseargsCmd; -static Tcl_ObjCmdProc TestparserObjCmd; -static Tcl_ObjCmdProc TestparsevarObjCmd; -static Tcl_ObjCmdProc TestparsevarnameObjCmd; -static Tcl_ObjCmdProc TestpreferstableObjCmd; -static Tcl_ObjCmdProc TestprintObjCmd; -static Tcl_ObjCmdProc TestregexpObjCmd; -static Tcl_ObjCmdProc TestreturnObjCmd; +static Tcl_ObjCmdProc2 TestparseargsCmd; +static Tcl_ObjCmdProc2 TestparserObjCmd; +static Tcl_ObjCmdProc2 TestparsevarObjCmd; +static Tcl_ObjCmdProc2 TestparsevarnameObjCmd; +static Tcl_ObjCmdProc2 TestpreferstableObjCmd; +static Tcl_ObjCmdProc2 TestprintObjCmd; +static Tcl_ObjCmdProc2 TestregexpObjCmd; +static Tcl_ObjCmdProc2 TestreturnObjCmd; static void TestregexpXflags(const char *string, int length, int *cflagsPtr, int *eflagsPtr); -static Tcl_ObjCmdProc TestsaveresultCmd; +static Tcl_ObjCmdProc2 TestsaveresultCmd; static void TestsaveresultFree(char *blockPtr); static Tcl_CmdProc TestsetassocdataCmd; static Tcl_CmdProc TestsetCmd; static Tcl_CmdProc Testset2Cmd; static Tcl_CmdProc TestseterrorcodeCmd; -static Tcl_ObjCmdProc TestsetobjerrorcodeCmd; +static Tcl_ObjCmdProc2 TestsetobjerrorcodeCmd; static Tcl_CmdProc TestsetplatformCmd; static Tcl_CmdProc TeststaticlibraryCmd; static Tcl_CmdProc TesttranslatefilenameCmd; static Tcl_CmdProc TestupvarCmd; -static Tcl_ObjCmdProc TestWrongNumArgsObjCmd; -static Tcl_ObjCmdProc TestGetIndexFromObjStructObjCmd; +static Tcl_ObjCmdProc2 TestWrongNumArgsObjCmd; +static Tcl_ObjCmdProc2 TestGetIndexFromObjStructObjCmd; static Tcl_CmdProc TestChannelCmd; static Tcl_CmdProc TestChannelEventCmd; static Tcl_CmdProc TestSocketCmd; -static Tcl_ObjCmdProc TestFilesystemObjCmd; -static Tcl_ObjCmdProc TestSimpleFilesystemObjCmd; +static Tcl_ObjCmdProc2 TestFilesystemObjCmd; +static Tcl_ObjCmdProc2 TestSimpleFilesystemObjCmd; static void TestReport(const char *cmd, Tcl_Obj *arg1, Tcl_Obj *arg2); -static Tcl_ObjCmdProc TestgetencpathObjCmd; -static Tcl_ObjCmdProc TestsetencpathObjCmd; +static Tcl_ObjCmdProc2 TestgetencpathObjCmd; +static Tcl_ObjCmdProc2 TestsetencpathObjCmd; static Tcl_Obj * TestReportGetNativePath(Tcl_Obj *pathPtr); static Tcl_FSStatProc TestReportStat; static Tcl_FSAccessProc TestReportAccess; @@ -326,20 +326,20 @@ static Tcl_FSListVolumesProc SimpleListVolumes; static Tcl_FSPathInFilesystemProc SimplePathInFilesystem; static Tcl_Obj * SimpleRedirect(Tcl_Obj *pathPtr); static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory; -static Tcl_ObjCmdProc TestUtfNextCmd; -static Tcl_ObjCmdProc TestUtfPrevCmd; -static Tcl_ObjCmdProc TestNumUtfCharsCmd; -static Tcl_ObjCmdProc TestFindFirstCmd; -static Tcl_ObjCmdProc TestFindLastCmd; -static Tcl_ObjCmdProc TestHashSystemHashCmd; -static Tcl_ObjCmdProc TestGetIntForIndexCmd; +static Tcl_ObjCmdProc2 TestUtfNextCmd; +static Tcl_ObjCmdProc2 TestUtfPrevCmd; +static Tcl_ObjCmdProc2 TestNumUtfCharsCmd; +static Tcl_ObjCmdProc2 TestFindFirstCmd; +static Tcl_ObjCmdProc2 TestFindLastCmd; +static Tcl_ObjCmdProc2 TestHashSystemHashCmd; +static Tcl_ObjCmdProc2 TestGetIntForIndexCmd; static Tcl_NRPostProc NREUnwind_callback; -static Tcl_ObjCmdProc TestNREUnwind; -static Tcl_ObjCmdProc TestNRELevels; -static Tcl_ObjCmdProc TestInterpResolverCmd; +static Tcl_ObjCmdProc2 TestNREUnwind; +static Tcl_ObjCmdProc2 TestNRELevels; +static Tcl_ObjCmdProc2 TestInterpResolverCmd; #if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL) -static Tcl_ObjCmdProc TestcpuidCmd; +static Tcl_ObjCmdProc2 TestcpuidCmd; #endif static const Tcl_Filesystem testReportingFilesystem = { @@ -522,7 +522,7 @@ Tcltest_Init( { Tcl_CmdInfo info; Tcl_Obj **objv, *objPtr; - int objc, index; + size_t objc, index; static const char *const specialOptions[] = { "-appinitprocerror", "-appinitprocdeleteinterp", "-appinitprocclosestderr", "-appinitprocsetrcfile", NULL @@ -552,23 +552,23 @@ Tcltest_Init( * Create additional commands and math functions for testing Tcl. */ - Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL); + Tcl_CreateObjCommand2(interp, "gettimes", GetTimesObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testpurebytesobj", TestpurebytesobjObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testsetbytearraylength", TestsetbytearraylengthObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd, + Tcl_CreateObjCommand2(interp, "noop", NoopObjCmd, NULL, NULL); + Tcl_CreateObjCommand2(interp, "testpurebytesobj", TestpurebytesobjObjCmd, NULL, NULL); + Tcl_CreateObjCommand2(interp, "testsetbytearraylength", TestsetbytearraylengthObjCmd, NULL, NULL); + Tcl_CreateObjCommand2(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL); + Tcl_CreateObjCommand2(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL); + Tcl_CreateObjCommand2(interp, "testwrongnumargs", TestWrongNumArgsObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, + Tcl_CreateObjCommand2(interp, "testfilesystem", TestFilesystemObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd, + Tcl_CreateObjCommand2(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct", + Tcl_CreateObjCommand2(interp, "testgetindexfromobjstruct", TestGetIndexFromObjStructObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testasync", TestasyncCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testbumpinterpepoch", + Tcl_CreateObjCommand2(interp, "testbumpinterpepoch", TestbumpinterpepochObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testchannel", TestChannelCmd, NULL, NULL); @@ -588,40 +588,40 @@ Tcltest_Init( Tcl_CreateCommand(interp, "testdel", TestdelCmd, NULL, NULL); Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testdoubledigits", TestdoubledigitsObjCmd, + Tcl_CreateObjCommand2(interp, "testdoubledigits", TestdoubledigitsObjCmd, NULL, NULL); Tcl_DStringInit(&dstring); Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testencoding", TestencodingObjCmd, NULL, + Tcl_CreateObjCommand2(interp, "testencoding", TestencodingObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testevalex", TestevalexObjCmd, + Tcl_CreateObjCommand2(interp, "testevalex", TestevalexObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testevalobjv", TestevalobjvObjCmd, + Tcl_CreateObjCommand2(interp, "testevalobjv", TestevalobjvObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testevent", TesteventObjCmd, + Tcl_CreateObjCommand2(interp, "testevent", TesteventObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testexithandler", TestexithandlerCmd, NULL, NULL); Tcl_CreateCommand(interp, "testexprlong", TestexprlongCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testexprlongobj", TestexprlongobjCmd, + Tcl_CreateObjCommand2(interp, "testexprlongobj", TestexprlongobjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testexprdouble", TestexprdoubleCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testexprdoubleobj", TestexprdoubleobjCmd, + Tcl_CreateObjCommand2(interp, "testexprdoubleobj", TestexprdoubleobjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testexprparser", TestexprparserObjCmd, + Tcl_CreateObjCommand2(interp, "testexprparser", TestexprparserObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testexprstring", TestexprstringCmd, NULL, NULL); Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testfilelink", TestfilelinkCmd, + Tcl_CreateObjCommand2(interp, "testfilelink", TestfilelinkCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testfile", TestfileCmd, + Tcl_CreateObjCommand2(interp, "testfile", TestfileCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testhashsystemhash", + Tcl_CreateObjCommand2(interp, "testhashsystemhash", TestHashSystemHashCmd, NULL, NULL); Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd, NULL, NULL); @@ -631,31 +631,31 @@ Tcltest_Init( NULL, NULL); Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testgetvarfullname", + Tcl_CreateObjCommand2(interp, "testgetvarfullname", TestgetvarfullnameCmd, NULL, NULL); Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd, NULL, NULL); Tcl_CreateCommand(interp, "testlink", TestlinkCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testlinkarray", TestlinkarrayCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, NULL, + Tcl_CreateObjCommand2(interp, "testlinkarray", TestlinkarrayCmd, NULL, NULL); + Tcl_CreateObjCommand2(interp, "testlocale", TestlocaleCmd, NULL, NULL); Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL); - Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd, + Tcl_CreateObjCommand2(interp, "testparseargs", TestparseargsCmd,NULL,NULL); + Tcl_CreateObjCommand2(interp, "testparser", TestparserObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd, + Tcl_CreateObjCommand2(interp, "testparsevar", TestparsevarObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd, + Tcl_CreateObjCommand2(interp, "testparsevarname", TestparsevarnameObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd, + Tcl_CreateObjCommand2(interp, "testpreferstable", TestpreferstableObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testprint", TestprintObjCmd, + Tcl_CreateObjCommand2(interp, "testprint", TestprintObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd, + Tcl_CreateObjCommand2(interp, "testregexp", TestregexpObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd, + Tcl_CreateObjCommand2(interp, "testreturn", TestreturnObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd, + Tcl_CreateObjCommand2(interp, "testsaveresult", TestsaveresultCmd, NULL, NULL); Tcl_CreateCommand(interp, "testservicemode", TestServiceModeCmd, NULL, NULL); @@ -669,19 +669,19 @@ Tcltest_Init( INT2PTR(TCL_LEAVE_ERR_MSG), NULL); Tcl_CreateCommand(interp, "testseterrorcode", TestseterrorcodeCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testsetobjerrorcode", + Tcl_CreateObjCommand2(interp, "testsetobjerrorcode", TestsetobjerrorcodeCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testutfnext", + Tcl_CreateObjCommand2(interp, "testutfnext", TestUtfNextCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testutfprev", + Tcl_CreateObjCommand2(interp, "testutfprev", TestUtfPrevCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testnumutfchars", + Tcl_CreateObjCommand2(interp, "testnumutfchars", TestNumUtfCharsCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testfindfirst", + Tcl_CreateObjCommand2(interp, "testfindfirst", TestFindFirstCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testfindlast", + Tcl_CreateObjCommand2(interp, "testfindlast", TestFindLastCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testgetintforindex", + Tcl_CreateObjCommand2(interp, "testgetintforindex", TestGetIntForIndexCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd, NULL, NULL); @@ -699,18 +699,18 @@ Tcltest_Init( Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd, NULL, NULL); #if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL) - Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd, + Tcl_CreateObjCommand2(interp, "testcpuid", TestcpuidCmd, NULL, NULL); #endif - Tcl_CreateObjCommand(interp, "testnreunwind", TestNREUnwind, + Tcl_CreateObjCommand2(interp, "testnreunwind", TestNREUnwind, NULL, NULL); - Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels, + Tcl_CreateObjCommand2(interp, "testnrelevels", TestNRELevels, NULL, NULL); - Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd, + Tcl_CreateObjCommand2(interp, "testinterpresolver", TestInterpResolverCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testgetencpath", TestgetencpathObjCmd, + Tcl_CreateObjCommand2(interp, "testgetencpath", TestgetencpathObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testsetencpath", TestsetencpathObjCmd, + Tcl_CreateObjCommand2(interp, "testsetencpath", TestsetencpathObjCmd, NULL, NULL); if (TclObjTest_Init(interp) != TCL_OK) { @@ -731,9 +731,11 @@ Tcltest_Init( objPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY); if (objPtr != NULL) { - if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) { + int val; + if (Tcl_ListObjGetElements(interp, objPtr, &val, &objv) != TCL_OK) { return TCL_ERROR; } + objc = val; if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL, TCL_EXACT, &index) == TCL_OK)) { switch (index) { @@ -1025,7 +1027,7 @@ static int TestbumpinterpepochObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *)interp; @@ -1101,7 +1103,9 @@ TestcmdinfoCmd( Tcl_AppendResult(interp, " unknown", NULL); } Tcl_AppendResult(interp, " ", info.namespacePtr->fullName, NULL); - if (info.isNativeObjectProc) { + if (info.isNativeObjectProc == 2) { + Tcl_AppendResult(interp, " nativeObjectProc2", NULL); + } else if (info.isNativeObjectProc == 1) { Tcl_AppendResult(interp, " nativeObjectProc", NULL); } else { Tcl_AppendResult(interp, " stringProc", NULL); @@ -1111,6 +1115,10 @@ TestcmdinfoCmd( info.clientData = (void *) "new_command_data"; info.objProc = NULL; info.objClientData = NULL; +#if TCL_MAJOR_VERSION > 8 || defined(TCL_NO_DEPRECATED) + info.objProc2 = NULL; + info.objClientData2 = NULL; +#endif info.deleteProc = CmdDelProc2; info.deleteData = (void *) "new_delete_data"; if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) { @@ -1302,7 +1310,7 @@ TestcmdtraceCmd( static int deleteCalled; deleteCalled = 0; - cmdTrace = Tcl_CreateObjTrace(interp, 50000, + cmdTrace = Tcl_CreateObjTrace2(interp, 50000, TCL_ALLOW_INLINE_COMPILATION, ObjTraceProc, &deleteCalled, ObjTraceDeleteProc); result = Tcl_EvalEx(interp, argv[2], -1, 0); @@ -1388,7 +1396,7 @@ ObjTraceProc( TCL_UNUSED(int) /*level*/, const char *command, TCL_UNUSED(Tcl_Command), - TCL_UNUSED(int) /*objc*/, + TCL_UNUSED(size_t) /*objc*/, Tcl_Obj *const objv[]) /* Argument objects. */ { const char *word = Tcl_GetString(objv[0]); @@ -1708,7 +1716,7 @@ static int TestdoubledigitsObjCmd( TCL_UNUSED(void *), Tcl_Interp* interp, /* Tcl interpreter */ - int objc, /* Parameter count */ + size_t objc, /* Parameter count */ Tcl_Obj* const objv[]) /* Parameter vector */ { static const char *options[] = { @@ -1921,7 +1929,7 @@ static int TestencodingObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Encoding encoding; @@ -2081,7 +2089,7 @@ static int TestevalexObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int length, flags; @@ -2126,7 +2134,7 @@ static int TestevalobjvObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int evalGlobal; @@ -2175,7 +2183,7 @@ static int TesteventObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Tcl interpreter */ - int objc, /* Parameter count */ + size_t objc, /* Parameter count */ Tcl_Obj *const objv[]) /* Parameter vector */ { static const char *const subcommands[] = { /* Possible subcommands */ @@ -2473,7 +2481,7 @@ static int TestexprlongobjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument objects. */ { long exprResult; @@ -2559,7 +2567,7 @@ static int TestexprdoubleobjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument objects. */ { double exprResult; @@ -2633,7 +2641,7 @@ static int TestfilelinkCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Tcl_Obj *contents; @@ -3286,7 +3294,7 @@ static int TestlinkarrayCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *LinkOption[] = { @@ -3305,7 +3313,8 @@ TestlinkarrayCmd( TCL_LINK_FLOAT, TCL_LINK_DOUBLE, TCL_LINK_STRING, TCL_LINK_CHARS, TCL_LINK_BINARY }; - int optionIndex, typeIndex, readonly, i, size, length; + int optionIndex, typeIndex, readonly, size, length; + size_t i; char *name, *arg; Tcl_WideInt addr; @@ -3404,7 +3413,7 @@ static int TestlocaleCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { int index; @@ -3490,7 +3499,7 @@ static int TestparserObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { const char *script; @@ -3546,7 +3555,7 @@ static int TestexprparserObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { const char *script; @@ -3694,7 +3703,7 @@ static int TestparsevarObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { const char *value, *name, *termPtr; @@ -3735,7 +3744,7 @@ static int TestparsevarnameObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { const char *script; @@ -3798,7 +3807,7 @@ static int TestpreferstableObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - TCL_UNUSED(int) /*objc*/, + TCL_UNUSED(size_t) /*objc*/, TCL_UNUSED(Tcl_Obj *const *) /*objv*/) { Interp *iPtr = (Interp *) interp; @@ -3828,7 +3837,7 @@ static int TestprintObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Tcl_WideInt argv1 = 0; @@ -3869,10 +3878,11 @@ static int TestregexpObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i, ii, indices, stringLength, match, about; + int ii, indices, stringLength, match, about; + size_t i; int hasxflags, cflags, eflags; Tcl_RegExp regExpr; const char *string; @@ -3941,7 +3951,7 @@ TestregexpObjCmd( } endOfForLoop: - if (objc - i < hasxflags + 2 - about) { + if (objc + about < hasxflags + i + 2) { Tcl_WrongNumArgs(interp, 1, objv, "?-switch ...? exp string ?matchVar? ?subMatchVar ...?"); return TCL_ERROR; @@ -4192,7 +4202,7 @@ static int TestreturnObjCmd( TCL_UNUSED(void *), TCL_UNUSED(Tcl_Interp *), - TCL_UNUSED(int) /*objc*/, + TCL_UNUSED(size_t) /*objc*/, TCL_UNUSED(Tcl_Obj *const *) /*objv*/) { return TCL_RETURN; @@ -4516,7 +4526,7 @@ static int TestsetobjerrorcodeCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Tcl_SetObjErrorCode(interp, Tcl_ConcatObj(objc - 1, objv + 1)); @@ -4635,10 +4645,11 @@ static int TestfileCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ + size_t argc, /* Number of arguments. */ Tcl_Obj *const argv[]) /* The argument objects. */ { - int force, i, j, result; + int force, result; + size_t i, j; Tcl_Obj *error = NULL; const char *subcmd; @@ -4717,7 +4728,7 @@ static int TestgetvarfullnameCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { const char *name, *arg; @@ -4791,7 +4802,7 @@ static int GetTimesObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* The current interpreter. */ - TCL_UNUSED(int) /*cobjc*/, + TCL_UNUSED(size_t) /*cobjc*/, TCL_UNUSED(Tcl_Obj *const *) /*cobjv*/) { Interp *iPtr = (Interp *) interp; @@ -4997,7 +5008,7 @@ static int NoopObjCmd( TCL_UNUSED(void *), TCL_UNUSED(Tcl_Interp *), - TCL_UNUSED(int) /*objc*/, + TCL_UNUSED(size_t) /*objc*/, TCL_UNUSED(Tcl_Obj *const *) /*objv*/) { return TCL_OK; @@ -5022,7 +5033,7 @@ static int TeststringbytesObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { int n; @@ -5062,7 +5073,7 @@ static int TestpurebytesobjObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Tcl_Obj *objPtr; @@ -5109,7 +5120,7 @@ static int TestsetbytearraylengthObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { int n; @@ -5153,7 +5164,7 @@ static int TestbytestringObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { size_t n = 0; @@ -5275,7 +5286,7 @@ static int TestsaveresultCmd( TCL_UNUSED(void *), Tcl_Interp *interp,/* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Interp* iPtr = (Interp*) interp; @@ -6318,10 +6329,11 @@ static int TestWrongNumArgsObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i, length; + Tcl_WideInt i; + int length; const char *msg; if (objc < 3) { @@ -6333,7 +6345,7 @@ TestWrongNumArgsObjCmd( return TCL_ERROR; } - if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[1], &i) != TCL_OK) { return TCL_ERROR; } @@ -6342,7 +6354,7 @@ TestWrongNumArgsObjCmd( msg = NULL; } - if (i > objc - 3) { + if ((size_t)i + 3 > objc) { /* * Asked for more arguments than were given. */ @@ -6374,7 +6386,7 @@ static int TestGetIndexFromObjStructObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *const ary[] = { @@ -6436,7 +6448,7 @@ static int TestFilesystemObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { int res, boolVal; @@ -6807,7 +6819,7 @@ static int TestSimpleFilesystemObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { int res, boolVal; @@ -6969,7 +6981,7 @@ static int TestUtfNextCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { int numBytes; @@ -7030,7 +7042,7 @@ static int TestUtfPrevCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { int numBytes, offset; @@ -7070,7 +7082,7 @@ static int TestNumUtfCharsCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { if (objc > 1) { @@ -7099,7 +7111,7 @@ static int TestFindFirstCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { if (objc > 1) { @@ -7121,7 +7133,7 @@ static int TestFindLastCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { if (objc > 1) { @@ -7139,7 +7151,7 @@ static int TestGetIntForIndexCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { int result; @@ -7190,7 +7202,7 @@ static int TestcpuidCmd( TCL_UNUSED(void *), Tcl_Interp* interp, /* Tcl interpreter */ - int objc, /* Parameter count */ + size_t objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ { int status, index, i; @@ -7226,7 +7238,7 @@ static int TestHashSystemHashCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { static const Tcl_HashKeyType hkType = { @@ -7371,7 +7383,7 @@ static int TestNREUnwind( TCL_UNUSED(void *), Tcl_Interp *interp, - TCL_UNUSED(int) /*objc*/, + TCL_UNUSED(size_t) /*objc*/, TCL_UNUSED(Tcl_Obj *const *) /*objv*/) { /* @@ -7389,7 +7401,7 @@ static int TestNRELevels( TCL_UNUSED(void *), Tcl_Interp *interp, - TCL_UNUSED(int) /*objc*/, + TCL_UNUSED(size_t) /*objc*/, TCL_UNUSED(Tcl_Obj *const *) /*objv*/) { Interp *iPtr = (Interp *) interp; @@ -7735,7 +7747,7 @@ static int TestgetencpathObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ { if (objc != 1) { @@ -7768,7 +7780,7 @@ static int TestsetencpathObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ { if (objc != 2) { @@ -7802,7 +7814,7 @@ static int TestparseargsCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Arguments. */ { static int foo = 0; @@ -8041,7 +8053,7 @@ static int TestInterpResolverCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { static const char *const table[] = { diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 223eb98..52bbff8 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -42,14 +42,14 @@ static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, size_t varInde static int GetVariableIndex(Tcl_Interp *interp, Tcl_Obj *obj, size_t *indexPtr); static void SetVarToObj(Tcl_Obj **varPtr, size_t varIndex, Tcl_Obj *objPtr); -static Tcl_ObjCmdProc TestbignumobjCmd; -static Tcl_ObjCmdProc TestbooleanobjCmd; -static Tcl_ObjCmdProc TestdoubleobjCmd; -static Tcl_ObjCmdProc TestindexobjCmd; -static Tcl_ObjCmdProc TestintobjCmd; -static Tcl_ObjCmdProc TestlistobjCmd; -static Tcl_ObjCmdProc TestobjCmd; -static Tcl_ObjCmdProc TeststringobjCmd; +static Tcl_ObjCmdProc2 TestbignumobjCmd; +static Tcl_ObjCmdProc2 TestbooleanobjCmd; +static Tcl_ObjCmdProc2 TestdoubleobjCmd; +static Tcl_ObjCmdProc2 TestindexobjCmd; +static Tcl_ObjCmdProc2 TestintobjCmd; +static Tcl_ObjCmdProc2 TestlistobjCmd; +static Tcl_ObjCmdProc2 TestobjCmd; +static Tcl_ObjCmdProc2 TeststringobjCmd; #define VARPTR_KEY "TCLOBJTEST_VARPTR" #define NUMBER_OF_OBJECT_VARS 20 @@ -110,20 +110,20 @@ TclObjTest_Init( varPtr[i] = NULL; } - Tcl_CreateObjCommand(interp, "testbignumobj", TestbignumobjCmd, + Tcl_CreateObjCommand2(interp, "testbignumobj", TestbignumobjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testbooleanobj", TestbooleanobjCmd, + Tcl_CreateObjCommand2(interp, "testbooleanobj", TestbooleanobjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testdoubleobj", TestdoubleobjCmd, + Tcl_CreateObjCommand2(interp, "testdoubleobj", TestdoubleobjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testintobj", TestintobjCmd, + Tcl_CreateObjCommand2(interp, "testintobj", TestintobjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd, + Tcl_CreateObjCommand2(interp, "testindexobj", TestindexobjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testlistobj", TestlistobjCmd, + Tcl_CreateObjCommand2(interp, "testlistobj", TestlistobjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd, + Tcl_CreateObjCommand2(interp, "testobj", TestobjCmd, NULL, NULL); + Tcl_CreateObjCommand2(interp, "teststringobj", TeststringobjCmd, NULL, NULL); return TCL_OK; } @@ -150,7 +150,7 @@ static int TestbignumobjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Tcl interpreter */ - int objc, /* Argument count */ + size_t objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ { const char *const subcmds[] = { @@ -349,7 +349,7 @@ static int TestbooleanobjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { size_t varIndex; @@ -449,7 +449,7 @@ static int TestdoubleobjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { size_t varIndex; @@ -565,10 +565,11 @@ static int TestindexobjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int allowAbbrev, index, setError, i, result; + int allowAbbrev, index, setError, result; + size_t i; Tcl_WideInt index2; const char **argv; static const char *const tablePtr[] = {"a", "b", "check", NULL}; @@ -655,7 +656,7 @@ static int TestintobjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { size_t varIndex; @@ -854,7 +855,7 @@ static int TestlistobjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Tcl interpreter */ - int objc, /* Number of arguments */ + size_t objc, /* Number of arguments */ Tcl_Obj *const objv[]) /* Argument objects */ { /* Subcommands supported by this command */ @@ -948,7 +949,7 @@ static int TestobjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { size_t varIndex, destIndex; @@ -1151,12 +1152,12 @@ static int TeststringobjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { unsigned short *unicode; - size_t varIndex; - int size, option, i; + size_t varIndex, i; + int size, option; Tcl_WideInt length; #define MAX_STRINGS 11 const char *string, *strings[MAX_STRINGS+1]; diff --git a/generic/tclTrace.c b/generic/tclTrace.c index c8f10e3..d84e183 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -2121,6 +2121,50 @@ TraceVarProc( *---------------------------------------------------------------------- */ +typedef struct { + Tcl_CmdObjTraceProc2 *proc; + Tcl_CmdObjTraceDeleteProc *delProc; + void *clientData; +} TraceWrapper; + +static int wrapperProc2( + void *clientData, + Tcl_Interp *interp, + int level, + const char *command, + Tcl_Command commandInfo, + int objc, + struct Tcl_Obj *const objv[]) +{ + TraceWrapper *wrapper = (TraceWrapper *)clientData; + return wrapper->proc(wrapper->clientData, interp, level, command, commandInfo, objc, objv); +} + +static void wrapperDelProc2(void *clientData) +{ + TraceWrapper *wrapper = (TraceWrapper *)clientData; + clientData = wrapper->clientData; + wrapper->delProc(clientData); + Tcl_Free(wrapper); +} + +Tcl_Trace +Tcl_CreateObjTrace2( + Tcl_Interp *interp, /* Tcl interpreter */ + int level, /* Maximum nesting level */ + int flags, /* Flags, see above */ + Tcl_CmdObjTraceProc2 *proc, /* Trace callback */ + void *clientData, /* Client data for the callback */ + Tcl_CmdObjTraceDeleteProc *delProc) + /* Function to call when trace is deleted */ +{ + TraceWrapper *wrapper = (TraceWrapper *)Tcl_Alloc(sizeof(TraceWrapper)); + wrapper->proc = proc; + wrapper->delProc = delProc; + wrapper->clientData = clientData; + return Tcl_CreateObjTrace(interp, level, flags, wrapperProc2, wrapper, wrapperDelProc2); +} + Tcl_Trace Tcl_CreateObjTrace( Tcl_Interp *interp, /* Tcl interpreter */ -- cgit v0.12