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