diff options
| -rw-r--r-- | doc/CrtObjCmd.3 | 19 | ||||
| -rw-r--r-- | doc/CrtTrace.3 | 10 | ||||
| -rw-r--r-- | doc/NRE.3 | 19 | ||||
| -rw-r--r-- | generic/tcl.decls | 21 | ||||
| -rw-r--r-- | generic/tcl.h | 12 | ||||
| -rw-r--r-- | generic/tclBasic.c | 153 | ||||
| -rw-r--r-- | generic/tclConfig.c | 2 | ||||
| -rw-r--r-- | generic/tclDecls.h | 37 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 6 | ||||
| -rw-r--r-- | generic/tclTest.c | 314 | ||||
| -rw-r--r-- | generic/tclTestObj.c | 55 | ||||
| -rw-r--r-- | generic/tclTrace.c | 50 |
12 files changed, 512 insertions, 186 deletions
diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3 index 8d10418..0490bd7 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 <tcl.h>\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_CreateObjCommand\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 <tcl.h>\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 @@ -9,7 +9,7 @@ .so man.macros .BS .SH NAME -Tcl_NRCreateCommand, Tcl_NRCallObjProc, Tcl_NREvalObj, Tcl_NREvalObjv, Tcl_NRCmdSwap, Tcl_NRExprObj, Tcl_NRAddCallback \- Non-Recursive (stackless) evaluation of Tcl scripts. +Tcl_NRCreateCommand, Tcl_NRCreateCommand2, Tcl_NRCallObjProc, Tcl_NRCallObjProc2, Tcl_NREvalObj, Tcl_NREvalObjv, Tcl_NRCmdSwap, Tcl_NRExprObj, Tcl_NRAddCallback \- Non-Recursive (stackless) evaluation of Tcl scripts. .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -18,10 +18,17 @@ 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_NRCallObjProc2\fR(\fIinterp, nreProc2, clientData, objc, objv\fR) +.sp +int \fBTcl_NREvalObj\fR(\fIinterp, objPtr, flags\fR) .sp int @@ -47,8 +54,15 @@ 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 +Called in order to evaluate a command. Is often just a small wrapper that uses +\fBTcl_NRCallObjProc2\fR to call \fInreProc2\fR using a new trampoline. Behaves +in the same way as the \fIproc2\fR argument to \fBTcl_CreateObjCommand2\fR(3) +(\fIq.v.\fR). .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 +118,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_NRCreateCommand\fR +in the same way as \fBTcl_CreateObjCommand2\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 a5b5539..2c5f01c 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2502,6 +2502,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) +} +declare 679 { + int Tcl_NRCallObjProc2(Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, + void *clientData, size_t objc, Tcl_Obj *const objv[]) +} # ----- BASELINE -- FOR -- 8.7.0 ----- # diff --git a/generic/tcl.h b/generic/tcl.h index 61b0c48..33b8217 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -665,6 +665,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); @@ -689,6 +692,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, ...); @@ -908,6 +913,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 a78a768..5501897 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -2689,6 +2689,61 @@ Tcl_CreateCommand( *---------------------------------------------------------------------- */ +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, + 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 @@ -3377,6 +3432,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, "?arg ...?"); + return TCL_ERROR; + } + return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); +} +#endif + int Tcl_GetCommandInfoFromToken( Tcl_Command cmd, @@ -3403,7 +3473,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; } @@ -9098,6 +9178,37 @@ Tcl_NRCallObjProc( return TclNRRunCallbacks(interp, TCL_OK, rootPtr); } +int wrapperNRObjProc( + void *clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; + clientData = info->clientData; + Tcl_ObjCmdProc2 *proc = info->proc; + ckfree(info); + return proc(clientData, interp, objc, objv); +} + +int +Tcl_NRCallObjProc2( + Tcl_Interp *interp, + Tcl_ObjCmdProc2 *objProc, + void *clientData, + size_t objc, + Tcl_Obj *const objv[]) +{ + NRE_callback *rootPtr = TOP_CB(interp); + CmdWrapperInfo *info = (CmdWrapperInfo *)ckalloc(sizeof(CmdWrapperInfo)); + info->clientData = clientData; + info->proc = objProc; + + TclNRAddCallback(interp, Dispatch, wrapperNRObjProc, info, + INT2PTR(objc), objv); + return TclNRRunCallbacks(interp, TCL_OK, rootPtr); +} + /* *---------------------------------------------------------------------- * @@ -9126,6 +9237,46 @@ Tcl_NRCallObjProc( *---------------------------------------------------------------------- */ +static int cmdWrapperNreProc( + void *clientData, + Tcl_Interp *interp, + int objc, + 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 diff --git a/generic/tclConfig.c b/generic/tclConfig.c index a145bac..5bffbcb 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -194,7 +194,7 @@ QueryConfigObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, - struct Tcl_Obj *const *objv) + Tcl_Obj *const *objv) { QCCD *cdPtr = (QCCD *)clientData; Tcl_Obj *pkgName = cdPtr->pkg; diff --git a/generic/tclDecls.h b/generic/tclDecls.h index bd22890..dcf2b82 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1976,6 +1976,27 @@ 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); +/* 678 */ +EXTERN Tcl_Command Tcl_NRCreateCommand2(Tcl_Interp *interp, + const char *cmdName, Tcl_ObjCmdProc2 *proc, + Tcl_ObjCmdProc2 *nreProc2, void *clientData, + Tcl_CmdDeleteProc *deleteProc); +/* 679 */ +EXTERN int Tcl_NRCallObjProc2(Tcl_Interp *interp, + Tcl_ObjCmdProc2 *objProc2, void *clientData, + size_t objc, Tcl_Obj *const objv[]); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2685,6 +2706,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 */ + Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */ + int (*tcl_NRCallObjProc2) (Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, size_t objc, Tcl_Obj *const objv[]); /* 679 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -4063,6 +4090,16 @@ 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 */ +#define Tcl_NRCreateCommand2 \ + (tclStubsPtr->tcl_NRCreateCommand2) /* 678 */ +#define Tcl_NRCallObjProc2 \ + (tclStubsPtr->tcl_NRCallObjProc2) /* 679 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index eae72ba..0052682 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -2033,6 +2033,12 @@ const TclStubs tclStubs = { TclUtfAtIndex, /* 671 */ TclGetRange, /* 672 */ TclGetUniChar, /* 673 */ + 0, /* 674 */ + 0, /* 675 */ + Tcl_CreateObjCommand2, /* 676 */ + Tcl_CreateObjTrace2, /* 677 */ + Tcl_NRCreateCommand2, /* 678 */ + Tcl_NRCallObjProc2, /* 679 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclTest.c b/generic/tclTest.c index 79a2fc9..89ecb8a 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 = { @@ -553,23 +553,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); @@ -589,40 +589,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); @@ -632,31 +632,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); @@ -670,19 +670,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); @@ -700,18 +700,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) { @@ -1026,7 +1026,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; @@ -1102,7 +1102,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); @@ -1112,6 +1114,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) { @@ -1303,7 +1309,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); @@ -1389,7 +1395,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]); @@ -1709,7 +1715,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[] = { @@ -1922,7 +1928,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; @@ -2082,7 +2088,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; @@ -2127,7 +2133,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; @@ -2176,7 +2182,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 */ @@ -2474,7 +2480,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; @@ -2560,7 +2566,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; @@ -2634,7 +2640,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; @@ -3287,7 +3293,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[] = { @@ -3306,7 +3312,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; @@ -3405,7 +3412,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; @@ -3491,7 +3498,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; @@ -3547,7 +3554,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; @@ -3695,7 +3702,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; @@ -3736,7 +3743,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; @@ -3799,7 +3806,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; @@ -3829,7 +3836,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; @@ -3870,10 +3877,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; @@ -3942,7 +3950,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; @@ -4193,7 +4201,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; @@ -4517,7 +4525,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)); @@ -4636,10 +4644,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; @@ -4718,7 +4727,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; @@ -4792,7 +4801,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; @@ -4998,7 +5007,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; @@ -5023,7 +5032,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; @@ -5063,7 +5072,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; @@ -5110,7 +5119,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; @@ -5154,7 +5163,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; @@ -5276,7 +5285,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; @@ -6319,10 +6328,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) { @@ -6334,7 +6344,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; } @@ -6343,7 +6353,7 @@ TestWrongNumArgsObjCmd( msg = NULL; } - if (i > objc - 3) { + if ((size_t)i + 3 > objc) { /* * Asked for more arguments than were given. */ @@ -6375,7 +6385,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[] = { @@ -6437,7 +6447,7 @@ static int TestFilesystemObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { int res, boolVal; @@ -6808,7 +6818,7 @@ static int TestSimpleFilesystemObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { int res, boolVal; @@ -6970,7 +6980,7 @@ static int TestUtfNextCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { int numBytes; @@ -7031,7 +7041,7 @@ static int TestUtfPrevCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { int numBytes, offset; @@ -7071,7 +7081,7 @@ static int TestNumUtfCharsCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { if (objc > 1) { @@ -7100,7 +7110,7 @@ static int TestFindFirstCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { if (objc > 1) { @@ -7122,7 +7132,7 @@ static int TestFindLastCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { if (objc > 1) { @@ -7140,7 +7150,7 @@ static int TestGetIntForIndexCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { int result; @@ -7191,7 +7201,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; @@ -7227,7 +7237,7 @@ static int TestHashSystemHashCmd( TCL_UNUSED(void *), Tcl_Interp *interp, - int objc, + size_t objc, Tcl_Obj *const objv[]) { static const Tcl_HashKeyType hkType = { @@ -7372,7 +7382,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*/) { /* @@ -7390,7 +7400,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; @@ -7737,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) { @@ -7770,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) { @@ -7804,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; @@ -8043,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 a03a60a..4cd41f9 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..0c243a6 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -1759,7 +1759,7 @@ TraceExecutionProc( const char *command, TCL_UNUSED(Tcl_Command), int objc, - struct Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) { int call = 0; Interp *iPtr = (Interp *) interp; @@ -2121,6 +2121,54 @@ TraceVarProc( *---------------------------------------------------------------------- */ +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, + 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 */ |