Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch tip-627 Excluding Merge-Ins
This is equivalent to a diff from 0c44322bba to a897984acf
2022-09-03
| ||
13:22 | Finish TIP #627 implementation for Tcl 9.0: handle objProc2/objClientData2 fields for Tcl_CmdInfo check-in: a2b5a59823 user: jan.nijtmans tags: trunk, main | |
2022-09-02
| ||
22:41 | Complete Tcl_SetCommandInfoFromToken() implementation, in case Tcl_CreateObjCommand() is used to cr... Closed-Leaf check-in: a897984acf user: jan.nijtmans tags: tip-627 | |
15:20 | Merge 8.7 check-in: cb0298ceba user: jan.nijtmans tags: trunk, main | |
14:41 | Some additional protection for objc < 0 check-in: 40cb7bb886 user: jan.nijtmans tags: tip-627 | |
14:32 | Merge 9.0 check-in: b397975685 user: jan.nijtmans tags: tip-627 | |
14:14 | Merge 8.7 check-in: 0c44322bba user: jan.nijtmans tags: trunk, main | |
14:13 | Merge 8.6 check-in: f6f80b73cc user: jan.nijtmans tags: core-8-branch | |
12:58 | Merge 8.7 check-in: 1be138a148 user: jan.nijtmans tags: trunk, main | |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
604 605 606 607 608 609 610 | * Side effects: * None. * *---------------------------------------------------------------------- */ static int | | | | | 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 | * Side effects: * None. * *---------------------------------------------------------------------- */ static int buildInfoObjCmd2( void *clientData, Tcl_Interp *interp, /* Current interpreter. */ size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc - 1 > 1) { Tcl_WrongNumArgs(interp, 1, objv, "?option?"); return TCL_ERROR; } if (objc == 2) { int len; const char *arg = TclGetStringFromObj(objv[1], &len); if (len == 7 && !strcmp(arg, "version")) { |
︙ | ︙ | |||
688 689 690 691 692 693 694 695 696 697 698 699 700 701 | } Tcl_AppendResult(interp, "0", NULL); return TCL_OK; } Tcl_AppendResult(interp, (char *)clientData, NULL); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_CreateInterp -- * * Create a new TCL command interpreter. | > > > > > > > > > > | 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 | } Tcl_AppendResult(interp, "0", NULL); return TCL_OK; } Tcl_AppendResult(interp, (char *)clientData, NULL); return TCL_OK; } static int buildInfoObjCmd( void *clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return buildInfoObjCmd2(clientData, interp, (size_t)objc, objv); } /* *---------------------------------------------------------------------- * * Tcl_CreateInterp -- * * Create a new TCL command interpreter. |
︙ | ︙ | |||
1230 1231 1232 1233 1234 1235 1236 | * Register Tcl's version number. * TIP #268: Full patchlevel instead of just major.minor * TIP #599: Extended build information "+<UUID>.<tag1>.<tag2>...." */ Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs); Tcl_PkgProvideEx(interp, "tcl", TCL_PATCH_LEVEL, &tclStubs); | > | | > > > | 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 | * Register Tcl's version number. * TIP #268: Full patchlevel instead of just major.minor * TIP #599: Extended build information "+<UUID>.<tag1>.<tag2>...." */ Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs); Tcl_PkgProvideEx(interp, "tcl", TCL_PATCH_LEVEL, &tclStubs); Tcl_CmdInfo info2; Tcl_Command buildInfoCmd = Tcl_CreateObjCommand(interp, "::tcl::build-info", buildInfoObjCmd, (void *)version, NULL); Tcl_GetCommandInfoFromToken(buildInfoCmd, &info2); info2.objProc2 = buildInfoObjCmd2; info2.objClientData2 = (void *)version; Tcl_SetCommandInfoFromToken(buildInfoCmd, &info2); if (TclTommath_Init(interp) != TCL_OK) { Tcl_Panic("%s", Tcl_GetStringResult(interp)); } if (TclOOInit(interp) != TCL_OK) { Tcl_Panic("%s", Tcl_GetStringResult(interp)); |
︙ | ︙ | |||
3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 | * returned. If the command doesn't exist then 0 is returned. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_SetCommandInfoFromToken( Tcl_Command cmd, const Tcl_CmdInfo *infoPtr) { Command *cmdPtr; /* Internal representation of the command */ | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 | * returned. If the command doesn't exist then 0 is returned. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int invokeObj2Command( void *clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; Command *cmdPtr = (Command *) clientData; if (objc > INT_MAX) { objc = TCL_INDEX_NONE; } if (cmdPtr->objProc != NULL) { result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); } else { result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc, cmdPtr->objClientData, objc, objv); } 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, const Tcl_CmdInfo *infoPtr) { Command *cmdPtr; /* Internal representation of the command */ |
︙ | ︙ | |||
3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 | cmdPtr->nreProc = NULL; cmdPtr->objProc = infoPtr->objProc; } cmdPtr->objClientData = infoPtr->objClientData; } if (cmdPtr->deleteProc == cmdWrapperDeleteProc) { CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData; info->deleteProc = infoPtr->deleteProc; info->deleteData = infoPtr->deleteData; } else { | > > > > > > > > > > > > > > > > > > > > > | | > | 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 | cmdPtr->nreProc = NULL; cmdPtr->objProc = infoPtr->objProc; } cmdPtr->objClientData = infoPtr->objClientData; } if (cmdPtr->deleteProc == cmdWrapperDeleteProc) { CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData; if (infoPtr->objProc2 == NULL) { info->proc = invokeObj2Command; info->clientData = cmdPtr; info->nreProc = NULL; } else { if (infoPtr->objProc2 != info->proc) { info->nreProc = NULL; info->proc = infoPtr->objProc2; } info->clientData = infoPtr->objClientData2; } info->deleteProc = infoPtr->deleteProc; info->deleteData = infoPtr->deleteData; } else { 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; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
3369 3370 3371 3372 3373 3374 3375 | if (cmd == NULL) { return 0; } /* * Set isNativeObjectProc 1 if objProc was registered by a call to | | > > > > > > > > | 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 | if (cmd == NULL) { return 0; } /* * Set isNativeObjectProc 1 if objProc was registered by a call to * Tcl_CreateObjCommand. Set isNativeObjectProc 2 if objProc was * registered by a call to Tcl_CreateObjCommand2. Otherwise set it to 0. */ cmdPtr = (Command *) cmd; infoPtr->isNativeObjectProc = (cmdPtr->objProc != TclInvokeStringCommand); infoPtr->objProc = cmdPtr->objProc; infoPtr->objClientData = cmdPtr->objClientData; infoPtr->proc = cmdPtr->proc; infoPtr->clientData = cmdPtr->clientData; if (cmdPtr->deleteProc == cmdWrapperDeleteProc) { CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData; infoPtr->deleteProc = info->deleteProc; infoPtr->deleteData = info->deleteData; infoPtr->objProc2 = info->proc; infoPtr->objClientData2 = info->clientData; if (cmdPtr->objProc == cmdWrapperProc) { infoPtr->isNativeObjectProc = 2; } } else { infoPtr->deleteProc = cmdPtr->deleteProc; infoPtr->deleteData = cmdPtr->deleteData; infoPtr->objProc2 = cmdWrapper2Proc; infoPtr->objClientData2 = cmdPtr; } infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr; return 1; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
8412 8413 8414 8415 8416 8417 8418 | int objc, Tcl_Obj *const objv[]) { CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; clientData = info->clientData; Tcl_ObjCmdProc2 *proc = info->proc; Tcl_Free(info); | > > > | | 8487 8488 8489 8490 8491 8492 8493 8494 8495 8496 8497 8498 8499 8500 8501 8502 8503 8504 | int objc, Tcl_Obj *const objv[]) { CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; clientData = info->clientData; Tcl_ObjCmdProc2 *proc = info->proc; Tcl_Free(info); if (objc < 0) { objc = -1; } return proc(clientData, interp, (size_t)objc, objv); } int Tcl_NRCallObjProc2( Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc, void *clientData, |
︙ | ︙ | |||
8468 8469 8470 8471 8472 8473 8474 | static int cmdWrapperNreProc( void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; | > > > | | 8546 8547 8548 8549 8550 8551 8552 8553 8554 8555 8556 8557 8558 8559 8560 8561 8562 8563 | static int cmdWrapperNreProc( void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; if (objc < 0) { objc = -1; } return info->nreProc(info->clientData, interp, (size_t)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 |
︙ | ︙ |
Changes to generic/tclIndexObj.c.
︙ | ︙ | |||
940 941 942 943 944 945 946 | } /* * Append a space character (" ") if there is more text to follow * (either another element from objv, or the message string). */ | | | 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 | } /* * Append a space character (" ") if there is more text to follow * (either another element from objv, or the message string). */ if (i + 1 < objc || message!=NULL) { Tcl_AppendStringsToObj(objPtr, " ", NULL); } } /* * Add any trailing message bits and set the resulting string as the * interpreter result. Caller is responsible for reporting this as an |
︙ | ︙ |
Changes to generic/tclTest.c.
︙ | ︙ | |||
289 290 291 292 293 294 295 | static Tcl_CmdProc Testset2Cmd; static Tcl_CmdProc TestseterrorcodeCmd; static Tcl_ObjCmdProc TestsetobjerrorcodeCmd; static Tcl_CmdProc TestsetplatformCmd; static Tcl_CmdProc TeststaticlibraryCmd; static Tcl_CmdProc TesttranslatefilenameCmd; static Tcl_CmdProc TestupvarCmd; | | | 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 | static Tcl_CmdProc Testset2Cmd; static Tcl_CmdProc TestseterrorcodeCmd; static Tcl_ObjCmdProc TestsetobjerrorcodeCmd; static Tcl_CmdProc TestsetplatformCmd; static Tcl_CmdProc TeststaticlibraryCmd; static Tcl_CmdProc TesttranslatefilenameCmd; static Tcl_CmdProc TestupvarCmd; static Tcl_ObjCmdProc2 TestWrongNumArgsObjCmd; static Tcl_ObjCmdProc TestGetIndexFromObjStructObjCmd; static Tcl_CmdProc TestChannelCmd; static Tcl_CmdProc TestChannelEventCmd; static Tcl_CmdProc TestSocketCmd; static Tcl_ObjCmdProc TestFilesystemObjCmd; static Tcl_ObjCmdProc TestSimpleFilesystemObjCmd; static void TestReport(const char *cmd, Tcl_Obj *arg1, |
︙ | ︙ | |||
575 576 577 578 579 580 581 | Tcl_CreateObjCommand(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); | | | 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 | Tcl_CreateObjCommand(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_CreateObjCommand2(interp, "testwrongnumargs", TestWrongNumArgsObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct", TestGetIndexFromObjStructObjCmd, NULL, NULL); |
︙ | ︙ | |||
6516 6517 6518 6519 6520 6521 6522 | *---------------------------------------------------------------------- */ static int TestWrongNumArgsObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ | | < | | | | 6516 6517 6518 6519 6520 6521 6522 6523 6524 6525 6526 6527 6528 6529 6530 6531 6532 6533 6534 6535 6536 6537 6538 6539 6540 | *---------------------------------------------------------------------- */ static int TestWrongNumArgsObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ size_t objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { size_t i, length; const char *msg; if (objc + 1 < 4) { goto insufArgs; } if (Tcl_GetIntForIndex(interp, objv[1], TCL_INDEX_NONE, &i) != TCL_OK) { return TCL_ERROR; } msg = Tcl_GetStringFromObj(objv[2], &length); if (length == 0) { msg = NULL; } |
︙ | ︙ |