Index: doc/CrtObjCmd.3 ================================================================== --- doc/CrtObjCmd.3 +++ doc/CrtObjCmd.3 @@ -6,18 +6,21 @@ '\" .TH Tcl_CreateObjCommand 3 8.0 Tcl "Tcl Library Procedures" .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 .sp 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 int \fBTcl_DeleteCommandFromToken\fR(\fIinterp, token\fR) @@ -50,10 +53,13 @@ .AP "const char" *cmdName in 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 Procedure to call before \fIcmdName\fR is deleted from the interpreter; allows for command-specific cleanup. If NULL, then no procedure is @@ -171,10 +177,21 @@ ClientData \fIclientData\fR); .CE .PP 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. If \fIcmdName\fR is not bound as a command in \fIinterp\fR then Index: doc/CrtTrace.3 ================================================================== --- doc/CrtTrace.3 +++ doc/CrtTrace.3 @@ -8,11 +8,11 @@ '\" .TH Tcl_CreateTrace 3 "" Tcl "Tcl Library Procedures" .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 .sp Tcl_Trace @@ -19,10 +19,13 @@ \fBTcl_CreateTrace\fR(\fIinterp, level, proc, clientData\fR) .sp 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 .AP Tcl_Interp *interp in Interpreter containing command to be traced or untraced. @@ -36,15 +39,18 @@ .AP int flags in 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 callback when the trace is deleted. .AP Tcl_Trace trace in Index: doc/NRE.3 ================================================================== --- doc/NRE.3 +++ doc/NRE.3 @@ -16,10 +16,14 @@ .sp 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 int \fBTcl_NREvalObj\fR(\fIinterp, objPtr, flags\fR) @@ -45,12 +49,16 @@ .AP Tcl_ObjCmdProc *proc in 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. .AP Tcl_CmdDeleteProc *deleteProc in/out Called before \fIcmdName\fR is deleted from the interpreter, allowing for @@ -101,10 +109,13 @@ command which may be used in subsequent calls to \fBTcl_GetCommandName\fR. Except for a few cases noted below any existing command by the same name is 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 \fBTcl_NREvalObjv\fR pushes a function that is like \fBTcl_EvalObjv\fR but Index: generic/tcl.decls ================================================================== --- generic/tcl.decls +++ generic/tcl.decls @@ -2468,10 +2468,27 @@ } 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 678 { + 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 ----- # ############################################################################## Index: generic/tcl.h ================================================================== --- generic/tcl.h +++ generic/tcl.h @@ -671,10 +671,13 @@ int level, char *command, Tcl_CmdProc *proc, ClientData cmdClientData, int argc, const char *argv[]); 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); typedef int (Tcl_EncodingConvertProc) (ClientData clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, @@ -695,10 +698,12 @@ typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr); 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, ...); typedef void (Tcl_TcpAcceptProc) (ClientData callbackData, Tcl_Channel chan, char *address, int port); @@ -914,10 +919,17 @@ Tcl_Namespace *namespacePtr;/* Points to the namespace that contains this * command. Note that Tcl_SetCmdInfo will not * 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; /* *---------------------------------------------------------------------------- * The structure defined below is used to hold dynamic strings. The only Index: generic/tclBasic.c ================================================================== --- generic/tclBasic.c +++ generic/tclBasic.c @@ -2686,10 +2686,65 @@ * the table, deleteProc will be called. See the manual entry for details * on the calling sequence. * *---------------------------------------------------------------------- */ + +typedef struct { + void *clientData; /* Arbitrary value to pass to object function. */ + Tcl_ObjCmdProc2 *proc; + Tcl_ObjCmdProc2 *nreProc; + 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; + ckfree(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 *)ckalloc(sizeof(CmdWrapperInfo)); + info->proc = proc; + info->deleteProc = deleteProc; + info->clientData = clientData; + + return Tcl_CreateObjCommand(interp, cmdName, + (proc ? cmdWrapperProc : NULL), + info, cmdWrapperDeleteProc); +} Tcl_Command Tcl_CreateObjCommand( Tcl_Interp *interp, /* Token for command interpreter (returned by * previous call to Tcl_CreateInterp). */ @@ -3375,10 +3430,25 @@ * None. * *---------------------------------------------------------------------- */ +#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, Tcl_CmdInfo *infoPtr) { @@ -3401,11 +3471,21 @@ infoPtr->proc = cmdPtr->proc; infoPtr->clientData = cmdPtr->clientData; 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; } /* *---------------------------------------------------------------------- @@ -9122,10 +9202,50 @@ * the table, deleteProc will be called. See the manual entry for details * on the calling sequence. * *---------------------------------------------------------------------- */ + +static int cmdWrapperNreProc( + void *clientData, + Tcl_Interp *interp, + int objc, + struct Tcl_Obj *const objv[]) +{ + CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; + return info->nreProc(info->clientData, interp, objc, objv); +} + +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. */ +{ + CmdWrapperInfo *info = (CmdWrapperInfo *)ckalloc(sizeof(CmdWrapperInfo)); + info->proc = proc; + info->nreProc = nreProc; + info->deleteProc = deleteProc; + info->clientData = clientData; + return Tcl_NRCreateCommand(interp, cmdName, + (proc ? cmdWrapperProc : NULL), + (nreProc ? cmdWrapperNreProc : NULL), + info, cmdWrapperDeleteProc); +} Tcl_Command Tcl_NRCreateCommand( Tcl_Interp *interp, /* Token for command interpreter (returned by * previous call to Tcl_CreateInterp). */ Index: generic/tclDecls.h ================================================================== --- generic/tclDecls.h +++ generic/tclDecls.h @@ -1972,10 +1972,27 @@ EXTERN const char * TclUtfAtIndex(const char *src, int index); /* 672 */ 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); +/* 678 */ +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; const struct TclIntStubs *tclIntStubs; const struct TclIntPlatStubs *tclIntPlatStubs; @@ -2681,10 +2698,15 @@ int (*tclNumUtfChars) (const char *src, int length); /* 669 */ int (*tclGetCharLength) (Tcl_Obj *objPtr); /* 670 */ 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 */ + Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */ } TclStubs; extern const TclStubs *tclStubsPtr; #ifdef __cplusplus @@ -4052,10 +4074,18 @@ (tclStubsPtr->tclUtfAtIndex) /* 671 */ #define TclGetRange \ (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 */ +#define Tcl_NRCreateCommand2 \ + (tclStubsPtr->tcl_NRCreateCommand2) /* 678 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ Index: generic/tclStubInit.c ================================================================== --- generic/tclStubInit.c +++ generic/tclStubInit.c @@ -1966,8 +1966,13 @@ TclNumUtfChars, /* 669 */ TclGetCharLength, /* 670 */ TclUtfAtIndex, /* 671 */ TclGetRange, /* 672 */ TclGetUniChar, /* 673 */ + 0, /* 674 */ + 0, /* 675 */ + Tcl_CreateObjCommand2, /* 676 */ + Tcl_CreateObjTrace2, /* 677 */ + Tcl_NRCreateCommand2, /* 678 */ }; /* !END!: Do not edit above this line. */ Index: generic/tclTest.c ================================================================== --- generic/tclTest.c +++ generic/tclTest.c @@ -201,101 +201,101 @@ Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, 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; static Tcl_CmdProc TestconcatobjCmd; 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; static Tcl_FSOpenFileChannelProc TestReportOpenFileChannel; static Tcl_FSMatchInDirectoryProc TestReportMatchInDirectory; @@ -324,24 +324,24 @@ static Tcl_FSOpenFileChannelProc SimpleOpenFileChannel; 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 = { "reporting", sizeof(Tcl_Filesystem), @@ -520,11 +520,11 @@ Tcltest_Init( Tcl_Interp *interp) /* Interpreter for application. */ { Tcl_CmdInfo info; Tcl_Obj **objv, *objPtr; - int objc, index; + size_t objc, index; static const char *const specialOptions[] = { "-appinitprocerror", "-appinitprocdeleteinterp", "-appinitprocclosestderr", "-appinitprocsetrcfile", NULL }; @@ -550,27 +550,27 @@ /* * 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, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct", + 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_CreateObjCommand2(interp, "testfilesystem", TestFilesystemObjCmd, + NULL, NULL); + Tcl_CreateObjCommand2(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd, + NULL, NULL); + 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); Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd, NULL, NULL); @@ -586,78 +586,78 @@ NULL, NULL); Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, NULL, NULL); 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); Tcl_CreateCommand(interp, "testgetint", TestgetintCmd, NULL, NULL); Tcl_CreateCommand(interp, "testlongsize", TestlongsizeCmd, 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, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testprint", TestprintObjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd, + Tcl_CreateObjCommand2(interp, "testparseargs", TestparseargsCmd,NULL,NULL); + Tcl_CreateObjCommand2(interp, "testparser", TestparserObjCmd, + NULL, NULL); + Tcl_CreateObjCommand2(interp, "testparsevar", TestparsevarObjCmd, + NULL, NULL); + Tcl_CreateObjCommand2(interp, "testparsevarname", TestparsevarnameObjCmd, + NULL, NULL); + Tcl_CreateObjCommand2(interp, "testpreferstable", TestpreferstableObjCmd, + NULL, NULL); + Tcl_CreateObjCommand2(interp, "testprint", TestprintObjCmd, + NULL, NULL); + Tcl_CreateObjCommand2(interp, "testregexp", TestregexpObjCmd, + NULL, NULL); + Tcl_CreateObjCommand2(interp, "testreturn", TestreturnObjCmd, + NULL, NULL); + Tcl_CreateObjCommand2(interp, "testsaveresult", TestsaveresultCmd, NULL, NULL); Tcl_CreateCommand(interp, "testservicemode", TestServiceModeCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd, NULL, NULL); @@ -667,23 +667,23 @@ INT2PTR(TCL_LEAVE_ERR_MSG), NULL); Tcl_CreateCommand(interp, "testset2", Testset2Cmd, 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); Tcl_CreateCommand(interp, "testsocket", TestSocketCmd, NULL, NULL); @@ -697,22 +697,22 @@ Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd, NULL, NULL); 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, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testgetencpath", TestgetencpathObjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testsetencpath", TestsetencpathObjCmd, + Tcl_CreateObjCommand2(interp, "testnreunwind", TestNREUnwind, + NULL, NULL); + Tcl_CreateObjCommand2(interp, "testnrelevels", TestNRELevels, + NULL, NULL); + Tcl_CreateObjCommand2(interp, "testinterpresolver", TestInterpResolverCmd, + NULL, NULL); + Tcl_CreateObjCommand2(interp, "testgetencpath", TestgetencpathObjCmd, + NULL, NULL); + Tcl_CreateObjCommand2(interp, "testsetencpath", TestsetencpathObjCmd, NULL, NULL); if (TclObjTest_Init(interp) != TCL_OK) { return TCL_ERROR; } @@ -729,13 +729,15 @@ * Check for special options used in ../tests/main.test */ 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) { case 0: return TCL_ERROR; @@ -1023,11 +1025,11 @@ 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; if (objc != 1) { @@ -1099,20 +1101,26 @@ (char *) info.deleteData, NULL); } else { 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); } } else if (strcmp(argv[1], "modify") == 0) { info.proc = CmdProc2; 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) { Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); } else { @@ -1300,11 +1308,11 @@ */ 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); Tcl_DeleteTrace(interp, cmdTrace); if (!deleteCalled) { @@ -1386,11 +1394,11 @@ TCL_UNUSED(void *), Tcl_Interp *interp, /* Tcl interpreter */ 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]); if (!strcmp(word, "Error")) { @@ -1706,11 +1714,11 @@ 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[] = { "shortest", "e", @@ -1919,11 +1927,11 @@ 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; int index, length; const char *string; @@ -2079,11 +2087,11 @@ 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; const char *script; @@ -2124,11 +2132,11 @@ 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; if (objc < 3) { @@ -2173,11 +2181,11 @@ 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 */ "queue", "delete", NULL }; @@ -2471,11 +2479,11 @@ 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; char buf[4 + TCL_INTEGER_SPACE]; int result; @@ -2557,11 +2565,11 @@ 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; char buf[4 + TCL_DOUBLE_SPACE]; int result; @@ -2631,11 +2639,11 @@ 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; if (objc < 2 || objc > 3) { @@ -3284,11 +3292,11 @@ 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[] = { "update", "remove", "create", NULL }; @@ -3303,11 +3311,12 @@ TCL_LINK_SHORT, TCL_LINK_USHORT, TCL_LINK_INT, TCL_LINK_UINT, TCL_LINK_LONG, TCL_LINK_ULONG, TCL_LINK_WIDE_INT, TCL_LINK_WIDE_UINT, 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; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option args"); @@ -3402,11 +3411,11 @@ 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; const char *locale; static const char *const optionStrings[] = { @@ -3488,11 +3497,11 @@ 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; int length, dummy; Tcl_Parse parse; @@ -3544,11 +3553,11 @@ 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; int length, dummy; Tcl_Parse parse; @@ -3692,11 +3701,11 @@ 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; if (objc != 2) { @@ -3733,11 +3742,11 @@ 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; int append, length, dummy; Tcl_Parse parse; @@ -3796,11 +3805,11 @@ 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; iPtr->packagePrefer = PKG_PREFER_STABLE; @@ -3826,11 +3835,11 @@ 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; size_t argv2; @@ -3867,14 +3876,15 @@ 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; Tcl_Obj *objPtr; Tcl_RegExpInfo info; @@ -3939,11 +3949,11 @@ goto endOfForLoop; } } 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; } objc -= i; @@ -4190,11 +4200,11 @@ 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; } @@ -4514,11 +4524,11 @@ 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)); return TCL_ERROR; } @@ -4633,14 +4643,15 @@ 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; if (argc < 3) { return TCL_ERROR; @@ -4715,11 +4726,11 @@ 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; int flags = 0; Tcl_Namespace *namespacePtr; @@ -4789,11 +4800,11 @@ 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; int i, n; double timePer; @@ -4995,11 +5006,11 @@ 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; } @@ -5020,11 +5031,11 @@ 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; const unsigned char *p; @@ -5060,11 +5071,11 @@ 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; if (objc > 2) { @@ -5107,11 +5118,11 @@ 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; Tcl_Obj *obj = NULL; @@ -5151,11 +5162,11 @@ 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; const char *p; @@ -5273,11 +5284,11 @@ 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; int discard, result, index; Tcl_SavedResult state; @@ -6316,14 +6327,15 @@ 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) { /* * Don't use Tcl_WrongNumArgs here, as that is the function @@ -6331,20 +6343,20 @@ */ Tcl_AppendResult(interp, "insufficient arguments", NULL); return TCL_ERROR; } - if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[1], &i) != TCL_OK) { return TCL_ERROR; } msg = Tcl_GetStringFromObj(objv[2], &length); if (length == 0) { msg = NULL; } - if (i > objc - 3) { + if ((size_t)i + 3 > objc) { /* * Asked for more arguments than were given. */ Tcl_AppendResult(interp, "insufficient arguments", NULL); return TCL_ERROR; @@ -6372,11 +6384,11 @@ 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[] = { "a", "b", "c", "d", "ee", "ff", NULL, NULL }; @@ -6434,11 +6446,11 @@ static int TestFilesystemObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { int res, boolVal; const char *msg; @@ -6805,11 +6817,11 @@ static int TestSimpleFilesystemObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { int res, boolVal; const char *msg; @@ -6967,11 +6979,11 @@ static int TestUtfNextCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { int numBytes; char *bytes; const char *result, *first; @@ -7028,11 +7040,11 @@ static int TestUtfPrevCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { int numBytes, offset; char *bytes; const char *result; @@ -7068,11 +7080,11 @@ static int TestNumUtfCharsCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { if (objc > 1) { int numBytes, len, limit = -1; const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes); @@ -7097,11 +7109,11 @@ static int TestFindFirstCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { if (objc > 1) { int len = -1; @@ -7119,11 +7131,11 @@ static int TestFindLastCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { if (objc > 1) { int len = -1; @@ -7137,11 +7149,11 @@ static int TestGetIntForIndexCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { int result; Tcl_WideInt endvalue; @@ -7188,11 +7200,11 @@ 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; int regs[4]; Tcl_Obj *regsObjs[4]; @@ -7224,11 +7236,11 @@ static int TestHashSystemHashCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { static const Tcl_HashKeyType hkType = { TCL_HASH_KEY_TYPE_VERSION, TCL_HASH_KEY_SYSTEM_HASH, NULL, NULL, NULL, NULL @@ -7369,11 +7381,11 @@ static int TestNREUnwind( TCL_UNUSED(void *), Tcl_Interp *interp, - TCL_UNUSED(int) /*objc*/, + TCL_UNUSED(size_t) /*objc*/, TCL_UNUSED(Tcl_Obj *const *) /*objv*/) { /* * Insure that callbacks effectively run at the proper level during the * unwinding of the NRE stack. @@ -7387,11 +7399,11 @@ 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; static ptrdiff_t *refDepth = NULL; ptrdiff_t depth; @@ -7733,11 +7745,11 @@ 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) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; @@ -7766,11 +7778,11 @@ 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) { Tcl_WrongNumArgs(interp, 1, objv, "defaultDir"); return TCL_ERROR; @@ -7800,11 +7812,11 @@ 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; int count = objc; Tcl_Obj **remObjv, *result[3]; @@ -8039,11 +8051,11 @@ static int TestInterpResolverCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { static const char *const table[] = { "down", "up", NULL }; Index: generic/tclTestObj.c ================================================================== --- generic/tclTestObj.c +++ generic/tclTestObj.c @@ -40,18 +40,18 @@ static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, size_t varIndex); 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 static void VarPtrDeleteProc(void *clientData, TCL_UNUSED(Tcl_Interp *)) @@ -108,24 +108,24 @@ Tcl_SetAssocData(interp, VARPTR_KEY, VarPtrDeleteProc, varPtr); for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) { varPtr[i] = NULL; } - Tcl_CreateObjCommand(interp, "testbignumobj", TestbignumobjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testbooleanobj", TestbooleanobjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testdoubleobj", TestdoubleobjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testintobj", TestintobjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testlistobj", TestlistobjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd, + Tcl_CreateObjCommand2(interp, "testbignumobj", TestbignumobjCmd, + NULL, NULL); + Tcl_CreateObjCommand2(interp, "testbooleanobj", TestbooleanobjCmd, + NULL, NULL); + Tcl_CreateObjCommand2(interp, "testdoubleobj", TestdoubleobjCmd, + NULL, NULL); + Tcl_CreateObjCommand2(interp, "testintobj", TestintobjCmd, + NULL, NULL); + Tcl_CreateObjCommand2(interp, "testindexobj", TestindexobjCmd, + NULL, NULL); + Tcl_CreateObjCommand2(interp, "testlistobj", TestlistobjCmd, + NULL, NULL); + Tcl_CreateObjCommand2(interp, "testobj", TestobjCmd, NULL, NULL); + Tcl_CreateObjCommand2(interp, "teststringobj", TeststringobjCmd, NULL, NULL); return TCL_OK; } /* @@ -148,11 +148,11 @@ 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[] = { "set", "get", "mult10", "div10", "iseven", "radixsize", NULL }; @@ -347,11 +347,11 @@ 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; int boolValue; const char *subCmd; @@ -447,11 +447,11 @@ 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; double doubleValue; const char *subCmd; @@ -563,14 +563,15 @@ 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}; /* @@ -653,11 +654,11 @@ 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; #if (INT_MAX != LONG_MAX) /* int is not the same size as long */ int i; @@ -852,11 +853,11 @@ 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 */ const char* subcommands[] = { "set", @@ -946,11 +947,11 @@ 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; int i; const char *subCmd; @@ -1149,16 +1150,16 @@ 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]; String *strPtr; Tcl_Obj **varPtr; Index: generic/tclTrace.c ================================================================== --- generic/tclTrace.c +++ generic/tclTrace.c @@ -2118,10 +2118,58 @@ * When the trace is deleted, the 'delProc' function will be invoked, * passing it the original client data. * *---------------------------------------------------------------------- */ + +typedef struct { + Tcl_CmdObjTraceProc2 *proc; + Tcl_CmdObjTraceDeleteProc *delProc; + void *clientData; +} TraceWrapperInfo; + +static int traceWrapperProc( + void *clientData, + Tcl_Interp *interp, + int level, + const char *command, + Tcl_Command commandInfo, + int objc, + struct Tcl_Obj *const objv[]) +{ + TraceWrapperInfo *info = (TraceWrapperInfo *)clientData; + return info->proc(info->clientData, interp, level, command, commandInfo, objc, objv); +} + +static void traceWrapperDelProc(void *clientData) +{ + TraceWrapperInfo *info = (TraceWrapperInfo *)clientData; + clientData = info->clientData; + if (info->delProc) { + info->delProc(clientData); + } + ckfree(info); +} + +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 */ +{ + TraceWrapperInfo *info = (TraceWrapperInfo *)ckalloc(sizeof(TraceWrapperInfo)); + info->proc = proc; + info->delProc = delProc; + info->clientData = clientData; + return Tcl_CreateObjTrace(interp, level, flags, + (proc ? traceWrapperProc : NULL), + info, traceWrapperDelProc); +} Tcl_Trace Tcl_CreateObjTrace( Tcl_Interp *interp, /* Tcl interpreter */ int level, /* Maximum nesting level */