From cd5e1b2e6cc18917b875413e8b7e40da7fb5002f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 2 Sep 2022 22:41:50 +0000 Subject: Complete Tcl_SetCommandInfoFromToken() implementation, in case Tcl_CreateObjCommand() is used to create the original Command, while objProc2 is filled later --- generic/tclBasic.c | 41 ++++++++++++++++++++++++++--------------- 1 file changed, 26 insertions(+), 15 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index f474b5d..b2ec58e 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -1245,11 +1245,11 @@ Tcl_CreateInterp(void) Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs); Tcl_PkgProvideEx(interp, "tcl", TCL_PATCH_LEVEL, &tclStubs); Tcl_CmdInfo info2; - Tcl_Command buildInfoCmd = Tcl_CreateObjCommand2(interp, "::tcl::build-info", - buildInfoObjCmd2, (void *)version, NULL); + Tcl_Command buildInfoCmd = Tcl_CreateObjCommand(interp, "::tcl::build-info", + buildInfoObjCmd, (void *)version, NULL); Tcl_GetCommandInfoFromToken(buildInfoCmd, &info2); - info2.objProc = buildInfoObjCmd; - info2.objClientData = (void *)version; + info2.objProc2 = buildInfoObjCmd2; + info2.objClientData2 = (void *)version; Tcl_SetCommandInfoFromToken(buildInfoCmd, &info2); if (TclTommath_Init(interp) != TCL_OK) { @@ -3306,6 +3306,15 @@ invokeObj2Command( return result; } +static int cmdWrapper2Proc(void *clientData, + Tcl_Interp *interp, + size_t objc, + Tcl_Obj *const objv[]) +{ + Command *cmdPtr = (Command *)clientData; + return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); +} + int Tcl_SetCommandInfoFromToken( Tcl_Command cmd, @@ -3351,8 +3360,19 @@ Tcl_SetCommandInfoFromToken( info->deleteProc = infoPtr->deleteProc; info->deleteData = infoPtr->deleteData; } else { - cmdPtr->deleteProc = infoPtr->deleteProc; - cmdPtr->deleteData = infoPtr->deleteData; + if ((infoPtr->objProc2 != NULL) && (infoPtr->objProc2 != cmdWrapper2Proc)) { + CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); + info->proc = infoPtr->objProc2; + info->clientData = infoPtr->objClientData2; + info->nreProc = NULL; + info->deleteProc = infoPtr->deleteProc; + info->deleteData = infoPtr->deleteData; + cmdPtr->deleteProc = cmdWrapperDeleteProc; + cmdPtr->deleteData = info; + } else { + cmdPtr->deleteProc = infoPtr->deleteProc; + cmdPtr->deleteData = infoPtr->deleteData; + } } return 1; } @@ -3407,15 +3427,6 @@ Tcl_GetCommandInfo( *---------------------------------------------------------------------- */ -static int cmdWrapper2Proc(void *clientData, - Tcl_Interp *interp, - size_t objc, - Tcl_Obj *const objv[]) -{ - Command *cmdPtr = (Command *)clientData; - return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); -} - int Tcl_GetCommandInfoFromToken( Tcl_Command cmd, -- cgit v0.12