From 7fd9e2f5fdd413114e252c3c3db7546551e309a9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" 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