Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | when compiling with TCL_NO_DEPRECATED, remove objProc interfaces |
|---|---|
| Timelines: | family | ancestors | descendants | both | tip-626 |
| Files: | files | file ages | folders |
| SHA3-256: |
44af621069d7b6ef67f092de44ea88e3 |
| User & Date: | jan.nijtmans 2022-08-29 19:56:09.827 |
Context
|
2022-08-29
| ||
| 21:59 | Make TclObjInterpProc() MODULE_SCOPE check-in: f8c96c2ba8 user: jan.nijtmans tags: tip-626 | |
| 19:56 | when compiling with TCL_NO_DEPRECATED, remove objProc interfaces check-in: 44af621069 user: jan.nijtmans tags: tip-626 | |
| 13:43 | More int -> size_t check-in: 4001be22d4 user: jan.nijtmans tags: tip-626 | |
Changes
Changes to generic/tcl.decls.
| ︙ | ︙ | |||
2574 2575 2576 2577 2578 2579 2580 |
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 {
| | | 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 |
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 ----- #
##############################################################################
|
| ︙ | ︙ |
Changes to generic/tcl.h.
| ︙ | ︙ | |||
548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 | typedef void (Tcl_CloseProc) (void *data); typedef void (Tcl_CmdDeleteProc) (void *clientData); typedef int (Tcl_CmdProc) (void *clientData, Tcl_Interp *interp, int argc, const char *argv[]); typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, void *cmdClientData, int argc, const char *argv[]); typedef int (Tcl_CmdObjTraceProc) (void *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) (void *clientData); typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr, struct Tcl_Obj *dupPtr); typedef int (Tcl_EncodingConvertProc) (void *clientData, const char *src, | > > | 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 | typedef void (Tcl_CloseProc) (void *data); typedef void (Tcl_CmdDeleteProc) (void *clientData); typedef int (Tcl_CmdProc) (void *clientData, Tcl_Interp *interp, int argc, const char *argv[]); typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, void *cmdClientData, int argc, const char *argv[]); #ifndef TCL_NO_DEPRECATED typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj *const *objv); #endif /* TCL_NO_DEPRECATED */ 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) (void *clientData); typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr, struct Tcl_Obj *dupPtr); typedef int (Tcl_EncodingConvertProc) (void *clientData, const char *src, |
| ︙ | ︙ | |||
574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 | #define Tcl_FileFreeProc Tcl_FreeProc typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr); typedef void (Tcl_FreeProc) (void *blockPtr); typedef void (Tcl_IdleProc) (void *clientData); typedef void (Tcl_InterpDeleteProc) (void *clientData, Tcl_Interp *interp); typedef void (Tcl_NamespaceDeleteProc) (void *clientData); typedef int (Tcl_ObjCmdProc) (void *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, ...); typedef void (Tcl_TcpAcceptProc) (void *callbackData, Tcl_Channel chan, char *address, int port); | > > | 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 | #define Tcl_FileFreeProc Tcl_FreeProc typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr); typedef void (Tcl_FreeProc) (void *blockPtr); typedef void (Tcl_IdleProc) (void *clientData); typedef void (Tcl_InterpDeleteProc) (void *clientData, Tcl_Interp *interp); typedef void (Tcl_NamespaceDeleteProc) (void *clientData); #ifndef TCL_NO_DEPRECATED typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); #endif /* TCL_NO_DEPRECATED */ 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, ...); typedef void (Tcl_TcpAcceptProc) (void *callbackData, Tcl_Channel chan, char *address, int port); |
| ︙ | ︙ | |||
775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 |
typedef struct {
int isNativeObjectProc; /* 1 if objProc was registered by a call to
* Tcl_CreateObjCommand; 2 if objProc was registered by
* a call to Tcl_CreateObjCommand2; 0 otherwise.
* Tcl_SetCmdInfo does not modify this
* field. */
Tcl_ObjCmdProc *objProc; /* Command's object-based function. */
void *objClientData; /* ClientData for object proc. */
Tcl_CmdProc *proc; /* Command's string-based function. */
void *clientData; /* ClientData for string proc. */
Tcl_CmdDeleteProc *deleteProc;
/* Function to call when command is
* deleted. */
void *deleteData; /* Value to pass to deleteProc (usually the
* same as clientData). */
| > > > > > | 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 |
typedef struct {
int isNativeObjectProc; /* 1 if objProc was registered by a call to
* Tcl_CreateObjCommand; 2 if objProc was registered by
* a call to Tcl_CreateObjCommand2; 0 otherwise.
* Tcl_SetCmdInfo does not modify this
* field. */
#ifdef TCL_NO_DEPRECATED
void *objProcNotUsed; /* Command's object-based function. */
void *objClientDataNotUsed; /* ClientData for object proc. */
#else
Tcl_ObjCmdProc *objProc; /* Command's object-based function. */
void *objClientData; /* ClientData for object proc. */
#endif
Tcl_CmdProc *proc; /* Command's string-based function. */
void *clientData; /* ClientData for string proc. */
Tcl_CmdDeleteProc *deleteProc;
/* Function to call when command is
* deleted. */
void *deleteData; /* Value to pass to deleteProc (usually the
* same as clientData). */
|
| ︙ | ︙ |
Changes to generic/tclBasic.c.
| ︙ | ︙ | |||
683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 |
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.
*
| > > > | 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 |
Tcl_AppendResult(interp, "0", NULL);
return TCL_OK;
}
Tcl_AppendResult(interp, (char *)clientData, NULL);
return TCL_OK;
}
#ifndef TCL_NO_DEPRECATED
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);
}
#endif
/*
*----------------------------------------------------------------------
*
* Tcl_CreateInterp --
*
* Create a new TCL command interpreter.
*
|
| ︙ | ︙ | |||
1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 |
* 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));
| > > > > > | 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 |
* 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);
#ifdef TCL_NO_DEPRECATED
Tcl_CreateObjCommand2(interp, "::tcl::build-info",
buildInfoObjCmd2, (void *)version, NULL);
#else
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);
#endif
if (TclTommath_Init(interp) != TCL_OK) {
Tcl_Panic("%s", Tcl_GetStringResult(interp));
}
if (TclOOInit(interp) != TCL_OK) {
Tcl_Panic("%s", Tcl_GetStringResult(interp));
|
| ︙ | ︙ | |||
2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 |
* Tcl_ObjCmdProc2 proc will be called. When the command is deleted from
* the table, deleteProc will be called. See the manual entry for details
* on the calling sequence.
*
*----------------------------------------------------------------------
*/
typedef struct {
Tcl_ObjCmdProc *proc;
void *clientData; /* Arbitrary value to pass to proc function. */
Tcl_CmdDeleteProc *deleteProc;
void *deleteData; /* Arbitrary value to pass to deleteProc function. */
Tcl_ObjCmdProc *nreProc;
} CmdWrapperInfo;
| > | 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 |
* Tcl_ObjCmdProc2 proc will be called. When the command is deleted from
* the table, deleteProc will be called. See the manual entry for details
* on the calling sequence.
*
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
typedef struct {
Tcl_ObjCmdProc *proc;
void *clientData; /* Arbitrary value to pass to proc function. */
Tcl_CmdDeleteProc *deleteProc;
void *deleteData; /* Arbitrary value to pass to deleteProc function. */
Tcl_ObjCmdProc *nreProc;
} CmdWrapperInfo;
|
| ︙ | ︙ | |||
2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 |
info->deleteProc = deleteProc;
info->deleteData = clientData;
return Tcl_CreateObjCommand2(interp, cmdName,
(proc ? cmdWrapperProc : NULL),
info, cmdWrapperDeleteProc);
}
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
| > | 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 |
info->deleteProc = deleteProc;
info->deleteData = clientData;
return Tcl_CreateObjCommand2(interp, cmdName,
(proc ? cmdWrapperProc : NULL),
info, cmdWrapperDeleteProc);
}
#endif /* TCL_NO_DEPRECATED */
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
|
| ︙ | ︙ | |||
3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 |
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
invokeObj2Command(
void *clientData, /* Points to command's Command structure. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
| > | 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 |
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
static int
invokeObj2Command(
void *clientData, /* Points to command's Command structure. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
|
| ︙ | ︙ | |||
3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 |
result = cmdPtr->objProc2(cmdPtr->objClientData2, interp, (size_t)objc, objv);
} else {
result = Tcl_NRCallObjProc2(interp, cmdPtr->nreProc2,
cmdPtr->objClientData2, (size_t)objc, objv);
}
return result;
}
int
Tcl_SetCommandInfoFromToken(
Tcl_Command cmd,
const Tcl_CmdInfo *infoPtr)
{
Command *cmdPtr; /* Internal representation of the command */
| > | 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 |
result = cmdPtr->objProc2(cmdPtr->objClientData2, interp, (size_t)objc, objv);
} else {
result = Tcl_NRCallObjProc2(interp, cmdPtr->nreProc2,
cmdPtr->objClientData2, (size_t)objc, objv);
}
return result;
}
#endif
int
Tcl_SetCommandInfoFromToken(
Tcl_Command cmd,
const Tcl_CmdInfo *infoPtr)
{
Command *cmdPtr; /* Internal representation of the command */
|
| ︙ | ︙ | |||
3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 |
} else {
if (infoPtr->objProc2 != cmdPtr->objProc2) {
cmdPtr->nreProc2 = NULL;
cmdPtr->objProc2 = infoPtr->objProc2;
}
cmdPtr->objClientData2 = infoPtr->objClientData2;
}
if (cmdPtr->deleteProc == cmdWrapperDeleteProc) {
CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData;
if (infoPtr->objProc == NULL) {
info->proc = invokeObj2Command;
info->clientData = cmdPtr;
info->nreProc = NULL;
} else {
if (infoPtr->objProc != info->proc) {
info->nreProc = NULL;
info->proc = infoPtr->objProc;
}
info->clientData = infoPtr->objClientData;
}
info->deleteProc = infoPtr->deleteProc;
info->deleteData = infoPtr->deleteData;
| > | > > | 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 |
} else {
if (infoPtr->objProc2 != cmdPtr->objProc2) {
cmdPtr->nreProc2 = NULL;
cmdPtr->objProc2 = infoPtr->objProc2;
}
cmdPtr->objClientData2 = infoPtr->objClientData2;
}
#ifndef TCL_NO_DEPRECATED
if (cmdPtr->deleteProc == cmdWrapperDeleteProc) {
CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData;
if (infoPtr->objProc == NULL) {
info->proc = invokeObj2Command;
info->clientData = cmdPtr;
info->nreProc = NULL;
} else {
if (infoPtr->objProc != info->proc) {
info->nreProc = NULL;
info->proc = infoPtr->objProc;
}
info->clientData = infoPtr->objClientData;
}
info->deleteProc = infoPtr->deleteProc;
info->deleteData = infoPtr->deleteData;
} else
#endif
{
cmdPtr->deleteProc = infoPtr->deleteProc;
cmdPtr->deleteData = infoPtr->deleteData;
}
return 1;
}
/*
|
| ︙ | ︙ | |||
3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 |
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int cmdWrapper2Proc(void *clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Command *cmdPtr = (Command *)clientData;
return cmdPtr->objProc2(cmdPtr->objClientData2, interp, objc, objv);
}
int
Tcl_GetCommandInfoFromToken(
Tcl_Command cmd,
Tcl_CmdInfo *infoPtr)
{
Command *cmdPtr; /* Internal representation of the command */
| > > | 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 |
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
static int cmdWrapper2Proc(void *clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Command *cmdPtr = (Command *)clientData;
return cmdPtr->objProc2(cmdPtr->objClientData2, interp, objc, objv);
}
#endif
int
Tcl_GetCommandInfoFromToken(
Tcl_Command cmd,
Tcl_CmdInfo *infoPtr)
{
Command *cmdPtr; /* Internal representation of the command */
|
| ︙ | ︙ | |||
3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 |
cmdPtr = (Command *) cmd;
infoPtr->isNativeObjectProc =
(cmdPtr->objProc2 != TclInvokeStringCommand) ? 2 : 0;
infoPtr->proc = cmdPtr->proc;
infoPtr->clientData = cmdPtr->clientData;
infoPtr->objProc2 = cmdPtr->objProc2;
infoPtr->objClientData2 = cmdPtr->objClientData2;
if (cmdPtr->deleteProc == cmdWrapperDeleteProc) {
CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData;
infoPtr->deleteProc = info->deleteProc;
infoPtr->deleteData = info->deleteData;
infoPtr->objProc = info->proc;
infoPtr->objClientData = info->clientData;
if (cmdPtr->objProc2 == cmdWrapperProc) {
infoPtr->isNativeObjectProc = 1;
}
| > | > > > > | 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 |
cmdPtr = (Command *) cmd;
infoPtr->isNativeObjectProc =
(cmdPtr->objProc2 != TclInvokeStringCommand) ? 2 : 0;
infoPtr->proc = cmdPtr->proc;
infoPtr->clientData = cmdPtr->clientData;
infoPtr->objProc2 = cmdPtr->objProc2;
infoPtr->objClientData2 = cmdPtr->objClientData2;
#ifndef TCL_NO_DEPRECATED
if (cmdPtr->deleteProc == cmdWrapperDeleteProc) {
CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData;
infoPtr->deleteProc = info->deleteProc;
infoPtr->deleteData = info->deleteData;
infoPtr->objProc = info->proc;
infoPtr->objClientData = info->clientData;
if (cmdPtr->objProc2 == cmdWrapperProc) {
infoPtr->isNativeObjectProc = 1;
}
} else
#endif
{
infoPtr->deleteProc = cmdPtr->deleteProc;
infoPtr->deleteData = cmdPtr->deleteData;
#ifndef TCL_NO_DEPRECATED
infoPtr->objProc = cmdWrapper2Proc;
infoPtr->objClientData = cmdPtr;
#endif
}
infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr;
return 1;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
8471 8472 8473 8474 8475 8476 8477 8478 8479 8480 8481 8482 8483 8484 |
NRE_callback *rootPtr = TOP_CB(interp);
TclNRAddCallback(interp, Dispatch, objProc, clientData,
INT2PTR(objc), objv);
return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}
int wrapperNRObjProc(
void *clientData,
Tcl_Interp *interp,
size_t objc,
Tcl_Obj *const objv[])
{
CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
| > | 8493 8494 8495 8496 8497 8498 8499 8500 8501 8502 8503 8504 8505 8506 8507 |
NRE_callback *rootPtr = TOP_CB(interp);
TclNRAddCallback(interp, Dispatch, objProc, clientData,
INT2PTR(objc), objv);
return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}
#ifndef TCL_NO_DEPRECATED
int wrapperNRObjProc(
void *clientData,
Tcl_Interp *interp,
size_t objc,
Tcl_Obj *const objv[])
{
CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
|
| ︙ | ︙ | |||
8505 8506 8507 8508 8509 8510 8511 8512 8513 8514 8515 8516 8517 8518 |
info->clientData = clientData;
info->proc = objProc;
TclNRAddCallback(interp, Dispatch, wrapperNRObjProc, info,
INT2PTR(objc), objv);
return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_NRCreateCommand --
*
* Define a new NRE-enabled object-based command in a command table.
| > | 8528 8529 8530 8531 8532 8533 8534 8535 8536 8537 8538 8539 8540 8541 8542 |
info->clientData = clientData;
info->proc = objProc;
TclNRAddCallback(interp, Dispatch, wrapperNRObjProc, info,
INT2PTR(objc), objv);
return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}
#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
*
* Tcl_NRCreateCommand --
*
* Define a new NRE-enabled object-based command in a command table.
|
| ︙ | ︙ | |||
8534 8535 8536 8537 8538 8539 8540 8541 8542 8543 8544 8545 8546 8547 |
* Tcl_ObjCmdProc2 proc will be called. When the command is deleted from
* the table, deleteProc will be called. See the manual entry for details
* on the calling sequence.
*
*----------------------------------------------------------------------
*/
static int cmdWrapperNreProc(
void *clientData,
Tcl_Interp *interp,
size_t objc,
Tcl_Obj *const objv[])
{
CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
| > | 8558 8559 8560 8561 8562 8563 8564 8565 8566 8567 8568 8569 8570 8571 8572 |
* Tcl_ObjCmdProc2 proc will be called. When the command is deleted from
* the table, deleteProc will be called. See the manual entry for details
* on the calling sequence.
*
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
static int cmdWrapperNreProc(
void *clientData,
Tcl_Interp *interp,
size_t objc,
Tcl_Obj *const objv[])
{
CmdWrapperInfo *info = (CmdWrapperInfo *)clientData;
|
| ︙ | ︙ | |||
8578 8579 8580 8581 8582 8583 8584 8585 8586 8587 8588 8589 8590 8591 |
info->deleteProc = deleteProc;
info->deleteData = clientData;
return Tcl_NRCreateCommand2(interp, cmdName,
proc ? cmdWrapperProc : NULL,
nreProc ? cmdWrapperNreProc : NULL, info,
cmdWrapperDeleteProc);
}
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
| > | 8603 8604 8605 8606 8607 8608 8609 8610 8611 8612 8613 8614 8615 8616 8617 |
info->deleteProc = deleteProc;
info->deleteData = clientData;
return Tcl_NRCreateCommand2(interp, cmdName,
proc ? cmdWrapperProc : NULL,
nreProc ? cmdWrapperNreProc : NULL, info,
cmdWrapperDeleteProc);
}
#endif /* TCL_NO_DEPRECATED */
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/tclDecls.h.
| ︙ | ︙ | |||
29 30 31 32 33 34 35 36 37 38 39 40 41 42 | # define TCL_DEPRECATED(msg) EXTERN TCL_DEPRECATED_API(msg) #elif defined(TCL_NO_DEPRECATED) # define TCL_DEPRECATED(msg) MODULE_SCOPE #else # define TCL_DEPRECATED(msg) EXTERN #endif /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made * in the generic/tcl.decls script. */ | > > > > | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 | # define TCL_DEPRECATED(msg) EXTERN TCL_DEPRECATED_API(msg) #elif defined(TCL_NO_DEPRECATED) # define TCL_DEPRECATED(msg) MODULE_SCOPE #else # define TCL_DEPRECATED(msg) EXTERN #endif #ifdef TCL_NO_DEPRECATED # define Tcl_ObjCmdProc void # define Tcl_CmdObjTraceProc void #endif /* TCL_NO_DEPRECATED */ /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made * in the generic/tcl.decls script. */ |
| ︙ | ︙ | |||
1822 1823 1824 1825 1826 1827 1828 | /* 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, | | | 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 |
/* 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;
const struct TclIntStubs *tclIntStubs;
const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;
|
| ︙ | ︙ | |||
2514 2515 2516 2517 2518 2519 2520 |
Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, size_t first, size_t last); /* 672 */
int (*tcl_GetUniChar) (Tcl_Obj *objPtr, size_t 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 */
| | | 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 |
Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, size_t first, size_t last); /* 672 */
int (*tcl_GetUniChar) (Tcl_Obj *objPtr, size_t 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;
#ifdef __cplusplus
}
#endif
|
| ︙ | ︙ | |||
3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 | #define Tcl_NRCallObjProc2 \ (tclStubsPtr->tcl_NRCallObjProc2) /* 679 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #ifdef _WIN32 # undef Tcl_CreateFileHandler # undef Tcl_DeleteFileHandler # undef Tcl_GetOpenFile #endif #undef TCL_STORAGE_CLASS | > > > > > | 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 | #define Tcl_NRCallObjProc2 \ (tclStubsPtr->tcl_NRCallObjProc2) /* 679 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #ifdef TCL_NO_DEPRECATED # undef Tcl_ObjCmdProc # undef Tcl_CmdObjTraceProc #endif /* TCL_NO_DEPRECATED */ #ifdef _WIN32 # undef Tcl_CreateFileHandler # undef Tcl_DeleteFileHandler # undef Tcl_GetOpenFile #endif #undef TCL_STORAGE_CLASS |
| ︙ | ︙ | |||
4200 4201 4202 4203 4204 4205 4206 | #undef Tcl_Close #define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0) #undef TclUtfCharComplete #undef TclUtfNext #undef TclUtfPrev | | > > > > > | 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 | #undef Tcl_Close #define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0) #undef TclUtfCharComplete #undef TclUtfNext #undef TclUtfPrev #ifdef TCL_NO_DEPRECATED # undef Tcl_CreateObjCommand # undef Tcl_CreateObjTrace # undef Tcl_NRCallObjProc # undef Tcl_NRCreateCommand #else # define Tcl_CreateSlave Tcl_CreateChild # define Tcl_GetSlave Tcl_GetChild # define Tcl_GetMaster Tcl_GetParent #endif #endif /* _TCLDECLS */ |
Changes to generic/tclExecute.c.
| ︙ | ︙ | |||
107 108 109 110 111 112 113 |
* Helpers for NR - non-recursive calls to TEBC
* Minimal data required to fully reconstruct the execution state.
*/
typedef struct {
ByteCode *codePtr; /* Constant until the BC returns */
/* -----------------------------------------*/
| | | | 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 |
* Helpers for NR - non-recursive calls to TEBC
* Minimal data required to fully reconstruct the execution state.
*/
typedef struct {
ByteCode *codePtr; /* Constant until the BC returns */
/* -----------------------------------------*/
Tcl_Obj **catchTop; /* These fields are used on return TO this */
Tcl_Obj *auxObjList; /* this level: they record the state when a */
CmdFrame cmdFrame; /* new codePtr was received for NR */
/* execution. */
Tcl_Obj *stack[1]; /* Start of the actual combined catch and obj
* stacks; the struct will be expanded as
* necessary */
} TEBCdata;
#define TEBC_YIELD() \
do { \
esPtr->tosPtr = tosPtr; \
|
| ︙ | ︙ | |||
1874 1875 1876 1877 1878 1879 1880 | * * Side effects: * Almost certainly, depending on the ByteCode's instructions. * *---------------------------------------------------------------------- */ #define bcFramePtr (&TD->cmdFrame) | | | | 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 |
*
* Side effects:
* Almost certainly, depending on the ByteCode's instructions.
*
*----------------------------------------------------------------------
*/
#define bcFramePtr (&TD->cmdFrame)
#define initCatchTop (TD->stack-1)
#define initTosPtr (initCatchTop+codePtr->maxExceptDepth)
#define esPtr (iPtr->execEnvPtr->execStackPtr)
int
TclNRExecuteByteCode(
Tcl_Interp *interp, /* Token for command interpreter. */
ByteCode *codePtr) /* The bytecode sequence to interpret. */
{
|
| ︙ | ︙ | |||
2659 2660 2661 2662 2663 2664 2665 |
starting = 1;
#endif
TRACE(("=> drop %" TCL_Z_MODIFIER "u items\n", objc));
NEXT_INST_V(1, objc, 0);
case INST_EXPAND_STKTOP: {
size_t i;
| > | | 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 |
starting = 1;
#endif
TRACE(("=> drop %" TCL_Z_MODIFIER "u items\n", objc));
NEXT_INST_V(1, objc, 0);
case INST_EXPAND_STKTOP: {
size_t i;
TEBCdata *newTD;
ptrdiff_t oldCatchTopOff, oldTosPtrOff;
/*
* Make sure that the element at stackTop is a list; if not, just
* leave with an error. Note that the element from the expand list
* will be removed at checkForCatch.
*/
|
| ︙ | ︙ | |||
2688 2689 2690 2691 2692 2693 2694 |
auxObjList->length += objc - 1;
if ((objc > 1) && (auxObjList->length > 0)) {
length = auxObjList->length /* Total expansion room we need */
+ codePtr->maxStackDepth /* Beyond the original max */
- CURR_DEPTH; /* Relative to where we are */
DECACHE_STACK_INFO();
| > > > | < | | | | | 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 |
auxObjList->length += objc - 1;
if ((objc > 1) && (auxObjList->length > 0)) {
length = auxObjList->length /* Total expansion room we need */
+ codePtr->maxStackDepth /* Beyond the original max */
- CURR_DEPTH; /* Relative to where we are */
DECACHE_STACK_INFO();
oldCatchTopOff = catchTop - initCatchTop;
oldTosPtrOff = tosPtr - initTosPtr;
newTD = (TEBCdata *)
GrowEvaluationStack(iPtr->execEnvPtr, length, 1);
if (newTD != TD) {
/*
* Change the global data to point to the new stack: move the
* TEBCdataPtr TD, recompute the position of every other
* stack-allocated parameter, update the stack pointers.
*/
TD = newTD;
catchTop = initCatchTop + oldCatchTopOff;
tosPtr = initTosPtr + oldTosPtrOff;
}
}
/*
* Expand the list at stacktop onto the stack; free the list. Knowing
* that it has a freeIntRepProc we use Tcl_DecrRefCount().
*/
|
| ︙ | ︙ | |||
4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 |
oPtr->flags &= ~FILTER_HANDLING;
}
{
Method *const mPtr =
contextPtr->callPtr->chain[newDepth].mPtr;
if (mPtr->typePtr->version == TCL_OO_METHOD_VERSION_1) {
if (objc > INT_MAX) {
TRACE_ERROR(interp);
goto gotError;
}
return ((Tcl_MethodCallProc *)(void *)mPtr->typePtr->callProc)(mPtr->clientData, interp,
(Tcl_ObjectContext) contextPtr, opnd, objv);
}
return mPtr->typePtr->callProc(mPtr->clientData, interp,
(Tcl_ObjectContext) contextPtr, opnd, objv);
}
case INST_TCLOO_IS_OBJECT:
oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS);
objResultPtr = TCONST(oPtr != NULL ? 1 : 0);
| > > | 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 |
oPtr->flags &= ~FILTER_HANDLING;
}
{
Method *const mPtr =
contextPtr->callPtr->chain[newDepth].mPtr;
#ifndef TCL_NO_DEPRECATED
if (mPtr->typePtr->version == TCL_OO_METHOD_VERSION_1) {
if (objc > INT_MAX) {
TRACE_ERROR(interp);
goto gotError;
}
return ((Tcl_MethodCallProc *)(void *)mPtr->typePtr->callProc)(mPtr->clientData, interp,
(Tcl_ObjectContext) contextPtr, opnd, objv);
}
#endif /* TCL_NO_DEPRECATED */
return mPtr->typePtr->callProc(mPtr->clientData, interp,
(Tcl_ObjectContext) contextPtr, opnd, objv);
}
case INST_TCLOO_IS_OBJECT:
oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS);
objResultPtr = TCONST(oPtr != NULL ? 1 : 0);
|
| ︙ | ︙ | |||
6415 6416 6417 6418 6419 6420 6421 |
case INST_BEGIN_CATCH4:
/*
* Record start of the catch command with exception range index equal
* to the operand. Push the current stack depth onto the special catch
* stack.
*/
| | | 6420 6421 6422 6423 6424 6425 6426 6427 6428 6429 6430 6431 6432 6433 6434 |
case INST_BEGIN_CATCH4:
/*
* Record start of the catch command with exception range index equal
* to the operand. Push the current stack depth onto the special catch
* stack.
*/
*(++catchTop) = INT2PTR(CURR_DEPTH);
TRACE(("%u => catchTop=%d, stackTop=%d\n",
TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1),
(int) CURR_DEPTH));
NEXT_INST_F(5, 0, 0);
break;
case INST_END_CATCH:
|
| ︙ | ︙ | |||
7330 7331 7332 7333 7334 7335 7336 |
/*
* Clear all expansions that may have started after the last
* INST_BEGIN_CATCH.
*/
while (auxObjList) {
if ((catchTop != initCatchTop)
| | | | 7335 7336 7337 7338 7339 7340 7341 7342 7343 7344 7345 7346 7347 7348 7349 7350 |
/*
* Clear all expansions that may have started after the last
* INST_BEGIN_CATCH.
*/
while (auxObjList) {
if ((catchTop != initCatchTop)
&& (PTR2INT(*catchTop) >
PTR2INT(auxObjList->internalRep.twoPtrValue.ptr2))) {
break;
}
POP_TAUX_OBJ();
}
/*
* We must not catch if the script in progress has been canceled with
|
| ︙ | ︙ | |||
7406 7407 7408 7409 7410 7411 7412 |
* "exception". It was found either by checkForCatch just above or by
* an instruction during break, continue, or error processing. Jump to
* its catchOffset after unwinding the operand stack to the depth it
* had when starting to execute the range's catch command.
*/
processCatch:
| | | | 7411 7412 7413 7414 7415 7416 7417 7418 7419 7420 7421 7422 7423 7424 7425 7426 7427 7428 7429 7430 7431 7432 7433 7434 |
* "exception". It was found either by checkForCatch just above or by
* an instruction during break, continue, or error processing. Jump to
* its catchOffset after unwinding the operand stack to the depth it
* had when starting to execute the range's catch command.
*/
processCatch:
while (CURR_DEPTH > PTR2INT(*catchTop)) {
valuePtr = POP_OBJECT();
TclDecrRefCount(valuePtr);
}
#ifdef TCL_COMPILE_DEBUG
if (traceInstructions) {
fprintf(stdout, " ... found catch at %" TCL_Z_MODIFIER "u, catchTop=%d, "
"unwound to %ld, new pc %" TCL_Z_MODIFIER "u\n",
rangePtr->codeOffset, (int) (catchTop - initCatchTop - 1),
(long)PTR2INT(*catchTop), rangePtr->catchOffset);
}
#endif
pc = (codePtr->codeStart + rangePtr->catchOffset);
NEXT_INST_F(0, 0, 0); /* Restart the execution loop at pc. */
/*
* end of infinite loop dispatching on instructions.
|
| ︙ | ︙ |
Changes to generic/tclInt.decls.
| ︙ | ︙ | |||
87 88 89 90 91 92 93 |
}
declare 38 {
int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName,
Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr,
Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr,
const char **simpleNamePtr)
}
| | | < > | 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 |
}
declare 38 {
int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName,
Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr,
Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr,
const char **simpleNamePtr)
}
#declare 39 {
# Tcl_ObjCmdProc2 *TclGetObjInterpProc(void)
#}
declare 40 {
int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr)
}
declare 41 {
Tcl_Command TclGetOriginalCommand(Tcl_Command command)
}
declare 42 {
|
| ︙ | ︙ | |||
589 590 591 592 593 594 595 596 597 598 599 600 601 602 |
Tcl_Obj *TclListTestObj(int length, int leadingSpace, int endSpace)
}
# TIP 625: for unit testing - check list invariants
declare 261 {
void TclListObjValidate(Tcl_Interp *interp, Tcl_Obj *listObj)
}
##############################################################################
# Define the platform specific internal Tcl interface. These functions are
# only available on the designated platform.
| > > > | 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 |
Tcl_Obj *TclListTestObj(int length, int leadingSpace, int endSpace)
}
# TIP 625: for unit testing - check list invariants
declare 261 {
void TclListObjValidate(Tcl_Interp *interp, Tcl_Obj *listObj)
}
declare 262 {
Tcl_ObjCmdProc2 *TclGetObjInterpProc2(void)
}
##############################################################################
# Define the platform specific internal Tcl interface. These functions are
# only available on the designated platform.
|
| ︙ | ︙ |
Changes to generic/tclIntDecls.h.
| ︙ | ︙ | |||
116 117 118 119 120 121 122 | /* 38 */ EXTERN int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); | | < | 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 | /* 38 */ EXTERN int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* Slot 39 is reserved */ /* 40 */ EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 41 */ EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command); /* 42 */ EXTERN const char * TclpGetUserHome(const char *name, |
| ︙ | ︙ | |||
572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 |
EXTERN void TclStaticLibrary(Tcl_Interp *interp,
const char *prefix,
Tcl_LibraryInitProc *initProc,
Tcl_LibraryInitProc *safeInitProc);
/* 258 */
EXTERN Tcl_Obj * TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj);
/* 260 */
EXTERN Tcl_Obj * TclListTestObj(int length, int leadingSpace,
int endSpace);
/* 261 */
EXTERN void TclListObjValidate(Tcl_Interp *interp,
Tcl_Obj *listObj);
typedef struct TclIntStubs {
int magic;
void *hooks;
void (*reserved0)(void);
void (*reserved1)(void);
| > > > | 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 |
EXTERN void TclStaticLibrary(Tcl_Interp *interp,
const char *prefix,
Tcl_LibraryInitProc *initProc,
Tcl_LibraryInitProc *safeInitProc);
/* 258 */
EXTERN Tcl_Obj * TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj);
/* Slot 259 is reserved */
/* 260 */
EXTERN Tcl_Obj * TclListTestObj(int length, int leadingSpace,
int endSpace);
/* 261 */
EXTERN void TclListObjValidate(Tcl_Interp *interp,
Tcl_Obj *listObj);
/* 262 */
EXTERN Tcl_ObjCmdProc2 * TclGetObjInterpProc2(void);
typedef struct TclIntStubs {
int magic;
void *hooks;
void (*reserved0)(void);
void (*reserved1)(void);
|
| ︙ | ︙ | |||
622 623 624 625 626 627 628 |
int (*tclGetFrame) (Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* 32 */
void (*reserved33)(void);
void (*reserved34)(void);
void (*reserved35)(void);
void (*reserved36)(void);
void (*reserved37)(void);
int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */
| | | 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 |
int (*tclGetFrame) (Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* 32 */
void (*reserved33)(void);
void (*reserved34)(void);
void (*reserved35)(void);
void (*reserved36)(void);
void (*reserved37)(void);
int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */
void (*reserved39)(void);
int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */
Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */
const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */
void (*reserved43)(void);
void (*reserved44)(void);
int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */
int (*tclInExit) (void); /* 46 */
|
| ︙ | ︙ | |||
842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 |
Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 252 */
Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 253 */
Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); /* 254 */
int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 256 */
void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 257 */
Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */
Tcl_Obj * (*tclListTestObj) (int length, int leadingSpace, int endSpace); /* 260 */
void (*tclListObjValidate) (Tcl_Interp *interp, Tcl_Obj *listObj); /* 261 */
} TclIntStubs;
extern const TclIntStubs *tclIntStubsPtr;
#ifdef __cplusplus
}
#endif
| > > | 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 |
Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 252 */
Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 253 */
Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); /* 254 */
int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 256 */
void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 257 */
Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */
void (*reserved259)(void);
Tcl_Obj * (*tclListTestObj) (int length, int leadingSpace, int endSpace); /* 260 */
void (*tclListObjValidate) (Tcl_Interp *interp, Tcl_Obj *listObj); /* 261 */
Tcl_ObjCmdProc2 * (*tclGetObjInterpProc2) (void); /* 262 */
} TclIntStubs;
extern const TclIntStubs *tclIntStubsPtr;
#ifdef __cplusplus
}
#endif
|
| ︙ | ︙ | |||
915 916 917 918 919 920 921 | /* Slot 33 is reserved */ /* Slot 34 is reserved */ /* Slot 35 is reserved */ /* Slot 36 is reserved */ /* Slot 37 is reserved */ #define TclGetNamespaceForQualName \ (tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */ | | < | 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 | /* Slot 33 is reserved */ /* Slot 34 is reserved */ /* Slot 35 is reserved */ /* Slot 36 is reserved */ /* Slot 37 is reserved */ #define TclGetNamespaceForQualName \ (tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */ /* Slot 39 is reserved */ #define TclGetOpenMode \ (tclIntStubsPtr->tclGetOpenMode) /* 40 */ #define TclGetOriginalCommand \ (tclIntStubsPtr->tclGetOriginalCommand) /* 41 */ #define TclpGetUserHome \ (tclIntStubsPtr->tclpGetUserHome) /* 42 */ /* Slot 43 is reserved */ |
| ︙ | ︙ | |||
1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 | (tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */ #define TclPtrUnsetVar \ (tclIntStubsPtr->tclPtrUnsetVar) /* 256 */ #define TclStaticLibrary \ (tclIntStubsPtr->tclStaticLibrary) /* 257 */ #define TclpCreateTemporaryDirectory \ (tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */ #define TclListTestObj \ (tclIntStubsPtr->tclListTestObj) /* 260 */ #define TclListObjValidate \ (tclIntStubsPtr->tclListObjValidate) /* 261 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #if defined(USE_TCL_STUBS) #undef Tcl_StaticLibrary | > > > | 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 | (tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */ #define TclPtrUnsetVar \ (tclIntStubsPtr->tclPtrUnsetVar) /* 256 */ #define TclStaticLibrary \ (tclIntStubsPtr->tclStaticLibrary) /* 257 */ #define TclpCreateTemporaryDirectory \ (tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */ /* Slot 259 is reserved */ #define TclListTestObj \ (tclIntStubsPtr->tclListTestObj) /* 260 */ #define TclListObjValidate \ (tclIntStubsPtr->tclListObjValidate) /* 261 */ #define TclGetObjInterpProc2 \ (tclIntStubsPtr->tclGetObjInterpProc2) /* 262 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #if defined(USE_TCL_STUBS) #undef Tcl_StaticLibrary |
| ︙ | ︙ |
Changes to generic/tclOO.h.
| ︙ | ︙ | |||
56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 |
/*
* Public datatypes for callbacks and structures used in the TIP#257 (OO)
* implementation. These are used to implement custom types of method calls
* and to allow the attachment of arbitrary data to objects and classes.
*/
typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp,
Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv);
typedef int (Tcl_MethodCallProc2)(void *clientData, Tcl_Interp *interp,
Tcl_ObjectContext objectContext, size_t objc, Tcl_Obj *const *objv);
typedef void (Tcl_MethodDeleteProc)(void *clientData);
typedef int (Tcl_CloneProc)(Tcl_Interp *interp, void *oldClientData,
void **newClientData);
typedef void (Tcl_ObjectMetadataDeleteProc)(void *clientData);
typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp,
Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj);
/*
* The type of a method implementation. This describes how to call the method
* implementation, how to delete it (when the object or class is deleted) and
* how to create a clone of it (when the object or class is copied).
*/
typedef struct {
int version; /* Structure version field. Always to be equal
* to TCL_OO_METHOD_VERSION_(1|CURRENT) in
* declarations. */
const char *name; /* Name of this type of method, mostly for
* debugging purposes. */
Tcl_MethodCallProc *callProc;
/* How to invoke this method. */
Tcl_MethodDeleteProc *deleteProc;
/* How to delete this method's type-specific
* data, or NULL if the type-specific data
* does not need deleting. */
Tcl_CloneProc *cloneProc; /* How to copy this method's type-specific
* data, or NULL if the type-specific data can
* be copied directly. */
} Tcl_MethodType;
typedef struct {
int version; /* Structure version field. Always to be equal
* to TCL_OO_METHOD_VERSION_2 in
* declarations. */
const char *name; /* Name of this type of method, mostly for
* debugging purposes. */
| > > > > | 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 |
/*
* Public datatypes for callbacks and structures used in the TIP#257 (OO)
* implementation. These are used to implement custom types of method calls
* and to allow the attachment of arbitrary data to objects and classes.
*/
#ifndef TCL_NO_DEPRECATED
typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp,
Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv);
#endif /* TCL_NO_DEPRECATED */
typedef int (Tcl_MethodCallProc2)(void *clientData, Tcl_Interp *interp,
Tcl_ObjectContext objectContext, size_t objc, Tcl_Obj *const *objv);
typedef void (Tcl_MethodDeleteProc)(void *clientData);
typedef int (Tcl_CloneProc)(Tcl_Interp *interp, void *oldClientData,
void **newClientData);
typedef void (Tcl_ObjectMetadataDeleteProc)(void *clientData);
typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp,
Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj);
/*
* The type of a method implementation. This describes how to call the method
* implementation, how to delete it (when the object or class is deleted) and
* how to create a clone of it (when the object or class is copied).
*/
#ifndef TCL_NO_DEPRECATED
typedef struct {
int version; /* Structure version field. Always to be equal
* to TCL_OO_METHOD_VERSION_(1|CURRENT) in
* declarations. */
const char *name; /* Name of this type of method, mostly for
* debugging purposes. */
Tcl_MethodCallProc *callProc;
/* How to invoke this method. */
Tcl_MethodDeleteProc *deleteProc;
/* How to delete this method's type-specific
* data, or NULL if the type-specific data
* does not need deleting. */
Tcl_CloneProc *cloneProc; /* How to copy this method's type-specific
* data, or NULL if the type-specific data can
* be copied directly. */
} Tcl_MethodType;
#endif /* TCL_NO_DEPRECATED */
typedef struct {
int version; /* Structure version field. Always to be equal
* to TCL_OO_METHOD_VERSION_2 in
* declarations. */
const char *name; /* Name of this type of method, mostly for
* debugging purposes. */
|
| ︙ | ︙ |
Changes to generic/tclOOCall.c.
| ︙ | ︙ | |||
365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 |
contextPtr->oPtr->flags &= ~FILTER_HANDLING;
}
/*
* Run the method implementation.
*/
if (mPtr->typePtr->version == TCL_OO_METHOD_VERSION_1) {
if (objc > INT_MAX) {
Tcl_WrongNumArgs(interp, 1, objv, "?args?");
return TCL_ERROR;
}
return ((Tcl_MethodCallProc *)(void *)mPtr->typePtr->callProc)(mPtr->clientData, interp,
(Tcl_ObjectContext) contextPtr, objc, objv);
}
return mPtr->typePtr->callProc(mPtr->clientData, interp,
(Tcl_ObjectContext) contextPtr, objc, objv);
}
static int
SetFilterFlags(
void *data[],
| > > | 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 |
contextPtr->oPtr->flags &= ~FILTER_HANDLING;
}
/*
* Run the method implementation.
*/
#ifndef TCL_NO_DEPRECATED
if (mPtr->typePtr->version == TCL_OO_METHOD_VERSION_1) {
if (objc > INT_MAX) {
Tcl_WrongNumArgs(interp, 1, objv, "?args?");
return TCL_ERROR;
}
return ((Tcl_MethodCallProc *)(void *)mPtr->typePtr->callProc)(mPtr->clientData, interp,
(Tcl_ObjectContext) contextPtr, objc, objv);
}
#endif /* TCL_NO_DEPRECATED */
return mPtr->typePtr->callProc(mPtr->clientData, interp,
(Tcl_ObjectContext) contextPtr, objc, objv);
}
static int
SetFilterFlags(
void *data[],
|
| ︙ | ︙ |
Changes to generic/tclOODecls.h.
| ︙ | ︙ | |||
13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
# endif
#endif
#ifdef USE_TCL_STUBS
# undef USE_TCLOO_STUBS
# define USE_TCLOO_STUBS
#endif
/* !BEGIN!: Do not edit below this line. */
#ifdef __cplusplus
extern "C" {
#endif
| > > > > | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 |
# endif
#endif
#ifdef USE_TCL_STUBS
# undef USE_TCLOO_STUBS
# define USE_TCLOO_STUBS
#endif
#ifdef TCL_NO_DEPRECATED
# define Tcl_MethodType void
#endif
/* !BEGIN!: Do not edit below this line. */
#ifdef __cplusplus
extern "C" {
#endif
|
| ︙ | ︙ | |||
265 266 267 268 269 270 271 272 273 | (tclOOStubsPtr->tcl_NewInstanceMethod2) /* 33 */ #define Tcl_NewMethod2 \ (tclOOStubsPtr->tcl_NewMethod2) /* 34 */ #endif /* defined(USE_TCLOO_STUBS) */ /* !END!: Do not edit above this line. */ #endif /* _TCLOODECLS */ | > > > > > > > | 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 | (tclOOStubsPtr->tcl_NewInstanceMethod2) /* 33 */ #define Tcl_NewMethod2 \ (tclOOStubsPtr->tcl_NewMethod2) /* 34 */ #endif /* defined(USE_TCLOO_STUBS) */ /* !END!: Do not edit above this line. */ #ifdef TCL_NO_DEPRECATED # undef Tcl_MethodType # undef Tcl_MethodIsType # undef Tcl_NewInstanceMethod # undef Tcl_NewMethod #endif #endif /* _TCLOODECLS */ |
Changes to generic/tclOOMethod.c.
| ︙ | ︙ | |||
184 185 186 187 188 189 190 191 192 193 194 195 196 197 |
oPtr->flags |= HAS_PRIVATE_METHODS;
}
}
oPtr->epoch++;
return (Tcl_Method) mPtr;
}
Tcl_Method
Tcl_NewInstanceMethod(
TCL_UNUSED(Tcl_Interp *),
Tcl_Object object, /* The object that has the method attached to
* it. */
Tcl_Obj *nameObj, /* The name of the method. May be NULL; if so,
* up to caller to manage storage (e.g., when
| > | 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 |
oPtr->flags |= HAS_PRIVATE_METHODS;
}
}
oPtr->epoch++;
return (Tcl_Method) mPtr;
}
#ifndef TCL_NO_DEPRECATED
Tcl_Method
Tcl_NewInstanceMethod(
TCL_UNUSED(Tcl_Interp *),
Tcl_Object object, /* The object that has the method attached to
* it. */
Tcl_Obj *nameObj, /* The name of the method. May be NULL; if so,
* up to caller to manage storage (e.g., when
|
| ︙ | ︙ | |||
206 207 208 209 210 211 212 213 214 215 216 217 218 219 |
{
if (typePtr->version != TCL_OO_METHOD_VERSION_1) {
Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_NewInstanceMethod");
}
return TclNewInstanceMethod(NULL, object, nameObj, flags,
(const Tcl_MethodType2 *)typePtr, clientData);
}
Tcl_Method
Tcl_NewInstanceMethod2(
TCL_UNUSED(Tcl_Interp *),
Tcl_Object object, /* The object that has the method attached to
* it. */
Tcl_Obj *nameObj, /* The name of the method. May be NULL; if so,
| > | 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 |
{
if (typePtr->version != TCL_OO_METHOD_VERSION_1) {
Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_NewInstanceMethod");
}
return TclNewInstanceMethod(NULL, object, nameObj, flags,
(const Tcl_MethodType2 *)typePtr, clientData);
}
#endif /* TCL_NO_DEPRECATED */
Tcl_Method
Tcl_NewInstanceMethod2(
TCL_UNUSED(Tcl_Interp *),
Tcl_Object object, /* The object that has the method attached to
* it. */
Tcl_Obj *nameObj, /* The name of the method. May be NULL; if so,
|
| ︙ | ︙ | |||
298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 |
clsPtr->flags |= HAS_PRIVATE_METHODS;
}
}
return (Tcl_Method) mPtr;
}
Tcl_Method
Tcl_NewMethod(
TCL_UNUSED(Tcl_Interp *),
Tcl_Class cls, /* The class to attach the method to. */
Tcl_Obj *nameObj, /* The name of the object. May be NULL (e.g.,
* for constructors or destructors); if so, up
* to caller to manage storage. */
int flags, /* Whether this is a public method. */
const Tcl_MethodType *typePtr,
/* The type of method this is, which defines
* how to invoke, delete and clone the
* method. */
void *clientData) /* Some data associated with the particular
* method to be created. */
{
if (typePtr->version != TCL_OO_METHOD_VERSION_1) {
Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_NewMethod");
}
return TclNewMethod(NULL, cls, nameObj, flags, (const Tcl_MethodType2 *)typePtr, clientData);
}
Tcl_Method
Tcl_NewMethod2(
TCL_UNUSED(Tcl_Interp *),
Tcl_Class cls, /* The class to attach the method to. */
Tcl_Obj *nameObj, /* The name of the object. May be NULL (e.g.,
* for constructors or destructors); if so, up
| > > | 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 |
clsPtr->flags |= HAS_PRIVATE_METHODS;
}
}
return (Tcl_Method) mPtr;
}
#ifndef TCL_NO_DEPRECATED
Tcl_Method
Tcl_NewMethod(
TCL_UNUSED(Tcl_Interp *),
Tcl_Class cls, /* The class to attach the method to. */
Tcl_Obj *nameObj, /* The name of the object. May be NULL (e.g.,
* for constructors or destructors); if so, up
* to caller to manage storage. */
int flags, /* Whether this is a public method. */
const Tcl_MethodType *typePtr,
/* The type of method this is, which defines
* how to invoke, delete and clone the
* method. */
void *clientData) /* Some data associated with the particular
* method to be created. */
{
if (typePtr->version != TCL_OO_METHOD_VERSION_1) {
Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_NewMethod");
}
return TclNewMethod(NULL, cls, nameObj, flags, (const Tcl_MethodType2 *)typePtr, clientData);
}
#endif /* TCL_NO_DEPRECATED */
Tcl_Method
Tcl_NewMethod2(
TCL_UNUSED(Tcl_Interp *),
Tcl_Class cls, /* The class to attach the method to. */
Tcl_Obj *nameObj, /* The name of the object. May be NULL (e.g.,
* for constructors or destructors); if so, up
|
| ︙ | ︙ | |||
1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 |
Tcl_Obj *
Tcl_MethodName(
Tcl_Method method)
{
return ((Method *) method)->namePtr;
}
int
Tcl_MethodIsType(
Tcl_Method method,
const Tcl_MethodType *typePtr,
void **clientDataPtr)
{
Method *mPtr = (Method *) method;
if (typePtr->version != TCL_OO_METHOD_VERSION_1) {
Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_MethodIsType");
}
if (mPtr->typePtr == (const Tcl_MethodType2 *)typePtr) {
if (clientDataPtr != NULL) {
*clientDataPtr = mPtr->clientData;
}
return 1;
}
return 0;
}
int
Tcl_MethodIsType2(
Tcl_Method method,
const Tcl_MethodType2 *typePtr,
void **clientDataPtr)
{
| > > | 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 |
Tcl_Obj *
Tcl_MethodName(
Tcl_Method method)
{
return ((Method *) method)->namePtr;
}
#ifndef TCL_NO_DEPRECATED
int
Tcl_MethodIsType(
Tcl_Method method,
const Tcl_MethodType *typePtr,
void **clientDataPtr)
{
Method *mPtr = (Method *) method;
if (typePtr->version != TCL_OO_METHOD_VERSION_1) {
Tcl_Panic("%s: Wrong version in typePtr->version, should be TCL_OO_METHOD_VERSION_1", "Tcl_MethodIsType");
}
if (mPtr->typePtr == (const Tcl_MethodType2 *)typePtr) {
if (clientDataPtr != NULL) {
*clientDataPtr = mPtr->clientData;
}
return 1;
}
return 0;
}
#endif /* TCL_NO_DEPRECATED */
int
Tcl_MethodIsType2(
Tcl_Method method,
const Tcl_MethodType2 *typePtr,
void **clientDataPtr)
{
|
| ︙ | ︙ |
Changes to generic/tclOOStubInit.c.
| ︙ | ︙ | |||
9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
#include "tclOOInt.h"
MODULE_SCOPE const TclOOStubs tclOOStubs;
#ifdef __GNUC__
#pragma GCC dependency "tclOO.decls"
#endif
/* !BEGIN!: Do not edit below this line. */
static const TclOOIntStubs tclOOIntStubs = {
TCL_STUB_MAGIC,
0,
TclOOGetDefineCmdContext, /* 0 */
| > > > > > > | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 |
#include "tclOOInt.h"
MODULE_SCOPE const TclOOStubs tclOOStubs;
#ifdef __GNUC__
#pragma GCC dependency "tclOO.decls"
#endif
#ifdef TCL_NO_DEPRECATED
# define Tcl_MethodIsType 0
# define Tcl_NewInstanceMethod 0
# define Tcl_NewMethod 0
#endif
/* !BEGIN!: Do not edit below this line. */
static const TclOOIntStubs tclOOIntStubs = {
TCL_STUB_MAGIC,
0,
TclOOGetDefineCmdContext, /* 0 */
|
| ︙ | ︙ |
Changes to generic/tclProc.c.
| ︙ | ︙ | |||
1575 1576 1577 1578 1579 1580 1581 |
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
| | > > > > > > > > > > > > > > > > > > > | 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 |
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclObjInterpProc/TclObjInterpProc2 --
*
* When a Tcl procedure gets invoked during bytecode evaluation, this
* object-based routine gets invoked to interpret the procedure.
*
* Results:
* A standard Tcl object result value.
*
* Side effects:
* Depends on the commands in the procedure.
*
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
static int
ObjInterpProc(
ClientData clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
int objc, /* Count of number of arguments to this
* procedure. */
Tcl_Obj *const objv[]) /* Argument value objects. */
{
/*
* Not used much in the core; external interface for iTcl
*/
return Tcl_NRCallObjProc2(interp, TclNRInterpProc, clientData, objc, objv);
}
#endif
int
TclObjInterpProc(
ClientData clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
|
| ︙ | ︙ | |||
2233 2234 2235 2236 2237 2238 2239 2240 | * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_ObjCmdProc2 * | > > > > > > > > | | 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 |
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
Tcl_ObjCmdProc *
TclGetObjInterpProc(void)
{
return ObjInterpProc;
}
#endif /* TCL_NO_DEPRECATED */
Tcl_ObjCmdProc2 *
TclGetObjInterpProc2(void)
{
return TclObjInterpProc;
}
/*
*----------------------------------------------------------------------
*
* TclNewProcBodyObj --
|
| ︙ | ︙ |
Changes to generic/tclStubInit.c.
| ︙ | ︙ | |||
74 75 76 77 78 79 80 81 82 83 84 85 86 87 |
#undef Tcl_Close
#define Tcl_Close 0
#undef TclGetByteArrayFromObj
#define TclGetByteArrayFromObj 0
#undef Tcl_GetByteArrayFromObj
#define Tcl_GetByteArrayFromObj 0
#if TCL_UTF_MAX < 4
static void uniCodePanic() {
Tcl_Panic("This extension uses a deprecated function, not available now: Tcl is compiled with -DTCL_UTF_MAX==%d", TCL_UTF_MAX);
}
# define Tcl_GetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, size_t *))(void *)uniCodePanic
# define TclGetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, int *))(void *)uniCodePanic
| > > > > > > | 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 |
#undef Tcl_Close
#define Tcl_Close 0
#undef TclGetByteArrayFromObj
#define TclGetByteArrayFromObj 0
#undef Tcl_GetByteArrayFromObj
#define Tcl_GetByteArrayFromObj 0
#ifdef TCL_NO_DEPRECATED
# define Tcl_CreateObjCommand 0
# define Tcl_CreateObjTrace 0
# define Tcl_NRCallObjProc 0
# define Tcl_NRCreateCommand 0
#endif
#if TCL_UTF_MAX < 4
static void uniCodePanic() {
Tcl_Panic("This extension uses a deprecated function, not available now: Tcl is compiled with -DTCL_UTF_MAX==%d", TCL_UTF_MAX);
}
# define Tcl_GetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, size_t *))(void *)uniCodePanic
# define TclGetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, int *))(void *)uniCodePanic
|
| ︙ | ︙ | |||
426 427 428 429 430 431 432 |
TclGetFrame, /* 32 */
0, /* 33 */
0, /* 34 */
0, /* 35 */
0, /* 36 */
0, /* 37 */
TclGetNamespaceForQualName, /* 38 */
| | | 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 |
TclGetFrame, /* 32 */
0, /* 33 */
0, /* 34 */
0, /* 35 */
0, /* 36 */
0, /* 37 */
TclGetNamespaceForQualName, /* 38 */
0, /* 39 */
TclGetOpenMode, /* 40 */
TclGetOriginalCommand, /* 41 */
TclpGetUserHome, /* 42 */
0, /* 43 */
0, /* 44 */
TclHideUnsafeCommands, /* 45 */
TclInExit, /* 46 */
|
| ︙ | ︙ | |||
646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 |
TclPtrGetVar, /* 252 */
TclPtrSetVar, /* 253 */
TclPtrIncrObjVar, /* 254 */
TclPtrObjMakeUpvar, /* 255 */
TclPtrUnsetVar, /* 256 */
TclStaticLibrary, /* 257 */
TclpCreateTemporaryDirectory, /* 258 */
TclListTestObj, /* 260 */
TclListObjValidate, /* 261 */
};
static const TclIntPlatStubs tclIntPlatStubs = {
TCL_STUB_MAGIC,
0,
0, /* 0 */
TclpCloseFile, /* 1 */
| > > | 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 |
TclPtrGetVar, /* 252 */
TclPtrSetVar, /* 253 */
TclPtrIncrObjVar, /* 254 */
TclPtrObjMakeUpvar, /* 255 */
TclPtrUnsetVar, /* 256 */
TclStaticLibrary, /* 257 */
TclpCreateTemporaryDirectory, /* 258 */
0, /* 259 */
TclListTestObj, /* 260 */
TclListObjValidate, /* 261 */
TclGetObjInterpProc2, /* 262 */
};
static const TclIntPlatStubs tclIntPlatStubs = {
TCL_STUB_MAGIC,
0,
0, /* 0 */
TclpCloseFile, /* 1 */
|
| ︙ | ︙ |
Changes to generic/tclTest.c.
| ︙ | ︙ | |||
79 80 81 82 83 84 85 86 87 88 89 90 91 92 |
Tcl_AsyncHandler handler; /* Tcl's token for the handler. */
char *command; /* Command to invoke when the handler is
* invoked. */
struct TestAsyncHandler *nextPtr;
/* Next is list of handlers. */
} TestAsyncHandler;
/*
* Start of the socket driver state structure to acces field testFlags
*/
typedef struct TcpState TcpState;
struct TcpState {
| > > > > > > > > > | 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 |
Tcl_AsyncHandler handler; /* Tcl's token for the handler. */
char *command; /* Command to invoke when the handler is
* invoked. */
struct TestAsyncHandler *nextPtr;
/* Next is list of handlers. */
} TestAsyncHandler;
#if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED)
#define Tcl_CreateObjCommand2 Tcl_CreateObjCommand
#define Tcl_ObjCmdProc2 Tcl_ObjCmdProc2
#define Tcl_CreateObjTrace2 Tcl_CreateObjTrace
#define TclSizeT int
#else
#define TclSizeT size_t
#endif
/*
* Start of the socket driver state structure to acces field testFlags
*/
typedef struct TcpState TcpState;
struct TcpState {
|
| ︙ | ︙ | |||
208 209 210 211 212 213 214 | static int EncodingFromUtfProc(void *clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); static void ExitProcEven(void *clientData); static void ExitProcOdd(void *clientData); | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 | static int EncodingFromUtfProc(void *clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); static void ExitProcEven(void *clientData); static void ExitProcOdd(void *clientData); static Tcl_ObjCmdProc2 GetTimesObjCmd; static Tcl_ResolveCompiledVarProc InterpCompiledVarResolver; static void MainLoop(void); static Tcl_CmdProc NoopCmd; static Tcl_ObjCmdProc2 NoopObjCmd; static int ObjTraceProc(void *clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandToken, TclSizeT objc, Tcl_Obj *const objv[]); static void ObjTraceDeleteProc(void *clientData); static void PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr); static void SpecialFree(void *blockPtr); static int StaticInitProc(Tcl_Interp *interp); static Tcl_CmdProc TestasyncCmd; 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; static Tcl_CmdProc TestconcatobjCmd; static Tcl_CmdProc TestcreatecommandCmd; static Tcl_CmdProc TestdcallCmd; static Tcl_CmdProc TestdelCmd; static Tcl_CmdProc TestdelassocdataCmd; static Tcl_ObjCmdProc2 TestdoubledigitsObjCmd; static Tcl_CmdProc TestdstringCmd; 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_ObjCmdProc2 TestexprlongobjCmd; static Tcl_CmdProc TestexprdoubleCmd; static Tcl_ObjCmdProc2 TestexprdoubleobjCmd; static Tcl_ObjCmdProc2 TestexprparserObjCmd; static Tcl_CmdProc TestexprstringCmd; 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_ObjCmdProc2 TestgetvarfullnameCmd; static Tcl_CmdProc TestinterpdeleteCmd; static Tcl_CmdProc TestlinkCmd; static Tcl_ObjCmdProc2 TestlinkarrayCmd; static Tcl_ObjCmdProc2 TestlistrepCmd; static Tcl_ObjCmdProc2 TestlocaleCmd; static Tcl_CmdProc TestmainthreadCmd; static Tcl_CmdProc TestsetmainloopCmd; static Tcl_CmdProc TestexitmainloopCmd; static Tcl_CmdProc TestpanicCmd; 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, size_t length, int *cflagsPtr, int *eflagsPtr); static Tcl_ObjCmdProc2 TestsaveresultCmd; static void TestsaveresultFree(void *blockPtr); static Tcl_CmdProc TestsetassocdataCmd; static Tcl_CmdProc TestsetCmd; static Tcl_CmdProc Testset2Cmd; static Tcl_CmdProc TestseterrorcodeCmd; static Tcl_ObjCmdProc2 TestsetobjerrorcodeCmd; static Tcl_CmdProc TestsetplatformCmd; static Tcl_CmdProc TeststaticlibraryCmd; static Tcl_CmdProc TesttranslatefilenameCmd; static Tcl_CmdProc TestupvarCmd; static Tcl_ObjCmdProc2 TestWrongNumArgsObjCmd; static Tcl_ObjCmdProc2 TestGetIndexFromObjStructObjCmd; static Tcl_CmdProc TestChannelCmd; static Tcl_CmdProc TestChannelEventCmd; static Tcl_CmdProc TestSocketCmd; static Tcl_ObjCmdProc2 TestFilesystemObjCmd; static Tcl_ObjCmdProc2 TestSimpleFilesystemObjCmd; static void TestReport(const char *cmd, Tcl_Obj *arg1, Tcl_Obj *arg2); static Tcl_ObjCmdProc2 TestgetencpathObjCmd; static Tcl_ObjCmdProc2 TestsetencpathObjCmd; static Tcl_Obj * TestReportGetNativePath(Tcl_Obj *pathPtr); static Tcl_FSStatProc TestReportStat; static Tcl_FSAccessProc TestReportAccess; static Tcl_FSOpenFileChannelProc TestReportOpenFileChannel; static Tcl_FSMatchInDirectoryProc TestReportMatchInDirectory; static Tcl_FSChdirProc TestReportChdir; static Tcl_FSLstatProc TestReportLstat; |
| ︙ | ︙ | |||
332 333 334 335 336 337 338 | static Tcl_FSStatProc SimpleStat; static Tcl_FSAccessProc SimpleAccess; static Tcl_FSOpenFileChannelProc SimpleOpenFileChannel; static Tcl_FSListVolumesProc SimpleListVolumes; static Tcl_FSPathInFilesystemProc SimplePathInFilesystem; static Tcl_Obj * SimpleRedirect(Tcl_Obj *pathPtr); static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory; | | | | | | | | | | | | | | 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 |
static Tcl_FSStatProc SimpleStat;
static Tcl_FSAccessProc SimpleAccess;
static Tcl_FSOpenFileChannelProc SimpleOpenFileChannel;
static Tcl_FSListVolumesProc SimpleListVolumes;
static Tcl_FSPathInFilesystemProc SimplePathInFilesystem;
static Tcl_Obj * SimpleRedirect(Tcl_Obj *pathPtr);
static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory;
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_ObjCmdProc2 TestNREUnwind;
static Tcl_ObjCmdProc2 TestNRELevels;
static Tcl_ObjCmdProc2 TestInterpResolverCmd;
#if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL)
static Tcl_ObjCmdProc2 TestcpuidCmd;
#endif
static Tcl_ObjCmdProc2 TestApplyLambdaObjCmd;
static const Tcl_Filesystem testReportingFilesystem = {
"reporting",
sizeof(Tcl_Filesystem),
TCL_FILESYSTEM_VERSION_1,
TestReportInFilesystem, /* path in */
TestReportDupInternalRep,
|
| ︙ | ︙ | |||
552 553 554 555 556 557 558 |
#endif
if (Tcl_OOInitStubs(interp) == NULL) {
return TCL_ERROR;
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
#if TCL_MAJOR_VERSION > 8
| < | | | < > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 |
#endif
if (Tcl_OOInitStubs(interp) == NULL) {
return TCL_ERROR;
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
#if TCL_MAJOR_VERSION > 8
Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
info.objProc2, (void *)version, NULL);
#else
Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
info.objProc, (void *)version, NULL);
#endif
}
if (Tcl_PkgProvideEx(interp, "tcl::test", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
return TCL_ERROR;
}
/*
* Create additional commands and math functions for testing Tcl.
*/
Tcl_CreateObjCommand2(interp, "gettimes", GetTimesObjCmd, NULL, NULL);
Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL);
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_CreateObjCommand2(interp, "testfilesystem", TestFilesystemObjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testgetindexfromobjstruct",
TestGetIndexFromObjStructObjCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testasync", TestasyncCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testbumpinterpepoch",
TestbumpinterpepochObjCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testchannel", TestChannelCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, NULL,
NULL);
Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, NULL,
NULL);
Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testconcatobj", TestconcatobjCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testdel", TestdelCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testdoubledigits", TestdoubledigitsObjCmd,
NULL, NULL);
Tcl_DStringInit(&dstring);
Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, NULL,
NULL);
Tcl_CreateObjCommand2(interp, "testencoding", TestencodingObjCmd, NULL,
NULL);
Tcl_CreateObjCommand2(interp, "testevalex", TestevalexObjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testevalobjv", TestevalobjvObjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testevent", TesteventObjCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testexithandler", TestexithandlerCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testexprlong", TestexprlongCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testexprlongobj", TestexprlongobjCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testexprdouble", TestexprdoubleCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testexprdoubleobj", TestexprdoubleobjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testexprparser", TestexprparserObjCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testexprstring", TestexprstringCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, NULL,
NULL);
Tcl_CreateObjCommand2(interp, "testfilelink", TestfilelinkCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testfile", TestfileCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testhashsystemhash",
TestHashSystemHashCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testgetint", TestgetintCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testlongsize", TestlongsizeCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testgetvarfullname",
TestgetvarfullnameCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testlink", TestlinkCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testlinkarray", TestlinkarrayCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testlistrep", TestlistrepCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testlocale", TestlocaleCmd, NULL,
NULL);
Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testparseargs", TestparseargsCmd,NULL,NULL);
Tcl_CreateObjCommand2(interp, "testparser", TestparserObjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testparsevar", TestparsevarObjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testparsevarname", TestparsevarnameObjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testpreferstable", TestpreferstableObjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testprint", TestprintObjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testregexp", TestregexpObjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testreturn", TestreturnObjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testsaveresult", TestsaveresultCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testservicemode", TestServiceModeCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testseterr", TestsetCmd,
INT2PTR(TCL_LEAVE_ERR_MSG), NULL);
Tcl_CreateCommand(interp, "testset2", Testset2Cmd,
INT2PTR(TCL_LEAVE_ERR_MSG), NULL);
Tcl_CreateCommand(interp, "testseterrorcode", TestseterrorcodeCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testsetobjerrorcode",
TestsetobjerrorcodeCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testutfnext",
TestUtfNextCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testutfprev",
TestUtfPrevCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testnumutfchars",
TestNumUtfCharsCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testfindfirst",
TestFindFirstCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testfindlast",
TestFindLastCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "testgetintforindex",
TestGetIntForIndexCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testsocket", TestSocketCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "teststaticlibrary", TeststaticlibraryCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testtranslatefilename",
TesttranslatefilenameCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL,
NULL);
Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
NULL, NULL);
#if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL)
Tcl_CreateObjCommand2(interp, "testcpuid", TestcpuidCmd,
NULL, NULL);
#endif
Tcl_CreateObjCommand2(interp, "testnreunwind", TestNREUnwind,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testnrelevels", TestNRELevels,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testinterpresolver", TestInterpResolverCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testgetencpath", TestgetencpathObjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testsetencpath", TestsetencpathObjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testapplylambda", TestApplyLambdaObjCmd,
NULL, NULL);
if (TclObjTest_Init(interp) != TCL_OK) {
return TCL_ERROR;
}
if (Procbodytest_Init(interp) != TCL_OK) {
return TCL_ERROR;
|
| ︙ | ︙ | |||
813 814 815 816 817 818 819 |
{
Tcl_CmdInfo info;
if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
| > | > > > > | 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 |
{
Tcl_CmdInfo info;
if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
#if TCL_MAJOR_VERSION > 8
Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
info.objProc2, (void *)version, NULL);
#else
Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
info.objProc, (void *)version, NULL);
#endif
}
if (Tcl_PkgProvideEx(interp, "tcl::test", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
return TCL_ERROR;
}
return Procbodytest_SafeInit(interp);
}
|
| ︙ | ︙ | |||
1045 1046 1047 1048 1049 1050 1051 |
TCL_THREAD_CREATE_RETURN;
}
static int
TestbumpinterpepochObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 |
TCL_THREAD_CREATE_RETURN;
}
static int
TestbumpinterpepochObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *)interp;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
|
| ︙ | ︙ | |||
1131 1132 1133 1134 1135 1136 1137 |
Tcl_AppendResult(interp, " stringProc", NULL);
} else {
Tcl_AppendResult(interp, " nativeObjectProc", NULL);
}
} else if (strcmp(argv[1], "modify") == 0) {
info.proc = CmdProc2;
info.clientData = (void *) "new_command_data";
| < < > > > | 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 |
Tcl_AppendResult(interp, " stringProc", NULL);
} else {
Tcl_AppendResult(interp, " nativeObjectProc", NULL);
}
} else if (strcmp(argv[1], "modify") == 0) {
info.proc = CmdProc2;
info.clientData = (void *) "new_command_data";
#if TCL_MAJOR_VERSION > 8
info.objProc2 = NULL;
info.objClientData2 = NULL;
#else
info.objProc = NULL;
info.objClientData = NULL;
#endif
info.deleteProc = CmdDelProc2;
info.deleteData = (void *) "new_delete_data";
if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) {
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
} else {
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1));
|
| ︙ | ︙ | |||
1346 1347 1348 1349 1350 1351 1352 | /* Create an object-based trace, then eval a script. This is used * to test return codes other than TCL_OK from the trace engine. */ static int deleteCalled; deleteCalled = 0; | | | 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 |
/* Create an object-based trace, then eval a script. This is used
* to test return codes other than TCL_OK from the trace engine.
*/
static int deleteCalled;
deleteCalled = 0;
cmdTrace = Tcl_CreateObjTrace2(interp, 50000,
TCL_ALLOW_INLINE_COMPILATION, ObjTraceProc,
&deleteCalled, ObjTraceDeleteProc);
result = Tcl_EvalEx(interp, argv[2], -1, 0);
Tcl_DeleteTrace(interp, cmdTrace);
if (!deleteCalled) {
Tcl_AppendResult(interp, "Delete wasn't called", NULL);
return TCL_ERROR;
|
| ︙ | ︙ | |||
1432 1433 1434 1435 1436 1437 1438 |
static int
ObjTraceProc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
TCL_UNUSED(int) /*level*/,
const char *command,
TCL_UNUSED(Tcl_Command),
| | | 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 |
static int
ObjTraceProc(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
TCL_UNUSED(int) /*level*/,
const char *command,
TCL_UNUSED(Tcl_Command),
TCL_UNUSED(TclSizeT) /*objc*/,
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *word = Tcl_GetString(objv[0]);
if (!strcmp(word, "Error")) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1));
return TCL_ERROR;
|
| ︙ | ︙ | |||
1752 1753 1754 1755 1756 1757 1758 |
*-----------------------------------------------------------------------------
*/
static int
TestdoubledigitsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
| | | 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 |
*-----------------------------------------------------------------------------
*/
static int
TestdoubledigitsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
TclSizeT objc, /* Parameter count */
Tcl_Obj* const objv[]) /* Parameter vector */
{
static const char *options[] = {
"shortest",
"e",
"f",
NULL
|
| ︙ | ︙ | |||
1965 1966 1967 1968 1969 1970 1971 |
*----------------------------------------------------------------------
*/
static int
TestencodingObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 |
*----------------------------------------------------------------------
*/
static int
TestencodingObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Encoding encoding;
int length;
const char *string;
TclEncoding *encodingPtr;
static const char *const optionStrings[] = {
|
| ︙ | ︙ | |||
2125 2126 2127 2128 2129 2130 2131 |
*----------------------------------------------------------------------
*/
static int
TestevalexObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 |
*----------------------------------------------------------------------
*/
static int
TestevalexObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int length, flags;
const char *script;
flags = 0;
if (objc == 3) {
|
| ︙ | ︙ | |||
2170 2171 2172 2173 2174 2175 2176 |
*----------------------------------------------------------------------
*/
static int
TestevalobjvObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 |
*----------------------------------------------------------------------
*/
static int
TestevalobjvObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int evalGlobal;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "global word ?word ...?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
2219 2220 2221 2222 2223 2224 2225 |
*----------------------------------------------------------------------
*/
static int
TesteventObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
| | | 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 |
*----------------------------------------------------------------------
*/
static int
TesteventObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
TclSizeT objc, /* Parameter count */
Tcl_Obj *const objv[]) /* Parameter vector */
{
static const char *const subcommands[] = { /* Possible subcommands */
"queue", "delete", NULL
};
int subCmdIndex; /* Index of the chosen subcommand */
static const char *const positions[] = { /* Possible queue positions */
|
| ︙ | ︙ | |||
2517 2518 2519 2520 2521 2522 2523 |
*----------------------------------------------------------------------
*/
static int
TestexprlongobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 |
*----------------------------------------------------------------------
*/
static int
TestexprlongobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument objects. */
{
long exprResult;
char buf[4 + TCL_INTEGER_SPACE];
int result;
if (objc != 2) {
|
| ︙ | ︙ | |||
2603 2604 2605 2606 2607 2608 2609 |
*----------------------------------------------------------------------
*/
static int
TestexprdoubleobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 |
*----------------------------------------------------------------------
*/
static int
TestexprdoubleobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument objects. */
{
double exprResult;
char buf[4 + TCL_DOUBLE_SPACE];
int result;
if (objc != 2) {
|
| ︙ | ︙ | |||
2677 2678 2679 2680 2681 2682 2683 |
*----------------------------------------------------------------------
*/
static int
TestfilelinkCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 |
*----------------------------------------------------------------------
*/
static int
TestfilelinkCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_Obj *contents;
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "source ?target?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
3330 3331 3332 3333 3334 3335 3336 |
*----------------------------------------------------------------------
*/
static int
TestlinkarrayCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | > | 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 |
*----------------------------------------------------------------------
*/
static int
TestlinkarrayCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *LinkOption[] = {
"update", "remove", "create", NULL
};
enum LinkOptionEnum {LINK_UPDATE, LINK_REMOVE, LINK_CREATE} optionIndex;
static const char *LinkType[] = {
"char", "uchar", "short", "ushort", "int", "uint", "long", "ulong",
"wide", "uwide", "float", "double", "string", "char*", "binary", NULL
};
/* all values after TCL_LINK_CHARS_ARRAY are used as arrays (see below) */
static int LinkTypes[] = {
TCL_LINK_CHAR, TCL_LINK_UCHAR,
TCL_LINK_SHORT, TCL_LINK_USHORT, TCL_LINK_INT, TCL_LINK_UINT,
TCL_LINK_LONG, TCL_LINK_ULONG, TCL_LINK_WIDE_INT, TCL_LINK_WIDE_UINT,
TCL_LINK_FLOAT, TCL_LINK_DOUBLE, TCL_LINK_STRING, TCL_LINK_CHARS,
TCL_LINK_BINARY
};
int typeIndex, readonly, size, length;
TclSizeT i;
char *name, *arg;
Tcl_WideInt addr;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option args");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
3448 3449 3450 3451 3452 3453 3454 |
*----------------------------------------------------------------------
*/
static int
TestlistrepCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 |
*----------------------------------------------------------------------
*/
static int
TestlistrepCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
/* Subcommands supported by this command */
const char* subcommands[] = {
"new",
"describe",
"config",
|
| ︙ | ︙ | |||
3600 3601 3602 3603 3604 3605 3606 |
*----------------------------------------------------------------------
*/
static int
TestlocaleCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 |
*----------------------------------------------------------------------
*/
static int
TestlocaleCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
int index;
const char *locale;
static const char *const optionStrings[] = {
"ctype", "numeric", "time", "collate", "monetary",
"all", NULL
|
| ︙ | ︙ | |||
3686 3687 3688 3689 3690 3691 3692 |
*----------------------------------------------------------------------
*/
static int
TestparserObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3701 3702 3703 3704 3705 3706 3707 3708 3709 3710 3711 3712 3713 3714 3715 |
*----------------------------------------------------------------------
*/
static int
TestparserObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
const char *script;
int length, dummy;
Tcl_Parse parse;
if (objc != 3) {
|
| ︙ | ︙ | |||
3742 3743 3744 3745 3746 3747 3748 |
*----------------------------------------------------------------------
*/
static int
TestexprparserObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 |
*----------------------------------------------------------------------
*/
static int
TestexprparserObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
const char *script;
int length, dummy;
Tcl_Parse parse;
if (objc != 3) {
|
| ︙ | ︙ | |||
3890 3891 3892 3893 3894 3895 3896 |
*----------------------------------------------------------------------
*/
static int
TestparsevarObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 |
*----------------------------------------------------------------------
*/
static int
TestparsevarObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
const char *value, *name, *termPtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "varName");
return TCL_ERROR;
|
| ︙ | ︙ | |||
3931 3932 3933 3934 3935 3936 3937 |
*----------------------------------------------------------------------
*/
static int
TestparsevarnameObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 |
*----------------------------------------------------------------------
*/
static int
TestparsevarnameObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
const char *script;
int append, length, dummy;
Tcl_Parse parse;
if (objc != 4) {
|
| ︙ | ︙ | |||
3994 3995 3996 3997 3998 3999 4000 |
*----------------------------------------------------------------------
*/
static int
TestpreferstableObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 |
*----------------------------------------------------------------------
*/
static int
TestpreferstableObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(TclSizeT) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
Interp *iPtr = (Interp *) interp;
iPtr->packagePrefer = PKG_PREFER_STABLE;
return TCL_OK;
}
|
| ︙ | ︙ | |||
4024 4025 4026 4027 4028 4029 4030 |
*----------------------------------------------------------------------
*/
static int
TestprintObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 |
*----------------------------------------------------------------------
*/
static int
TestprintObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_WideInt argv1 = 0;
size_t argv2;
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "format wideint");
|
| ︙ | ︙ | |||
4065 4066 4067 4068 4069 4070 4071 |
*----------------------------------------------------------------------
*/
static int
TestregexpObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | > | 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 |
*----------------------------------------------------------------------
*/
static int
TestregexpObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int indices, stringLength, match, about;
TclSizeT i;
size_t ii;
int hasxflags, cflags, eflags;
Tcl_RegExp regExpr;
const char *string;
Tcl_Obj *objPtr;
Tcl_RegExpInfo info;
static const char *const options[] = {
|
| ︙ | ︙ | |||
4137 4138 4139 4140 4141 4142 4143 |
case REGEXP_LAST:
i++;
goto endOfForLoop;
}
}
endOfForLoop:
| | | 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 |
case REGEXP_LAST:
i++;
goto endOfForLoop;
}
}
endOfForLoop:
if (objc + about < hasxflags + 2 + i) {
Tcl_WrongNumArgs(interp, 1, objv,
"?-switch ...? exp string ?matchVar? ?subMatchVar ...?");
return TCL_ERROR;
}
objc -= i;
objv += i;
|
| ︙ | ︙ | |||
4389 4390 4391 4392 4393 4394 4395 |
*----------------------------------------------------------------------
*/
static int
TestreturnObjCmd(
TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
| | | 4405 4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 |
*----------------------------------------------------------------------
*/
static int
TestreturnObjCmd(
TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
TCL_UNUSED(TclSizeT) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
return TCL_RETURN;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
4713 4714 4715 4716 4717 4718 4719 |
*----------------------------------------------------------------------
*/
static int
TestsetobjerrorcodeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 |
*----------------------------------------------------------------------
*/
static int
TestsetobjerrorcodeCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_SetObjErrorCode(interp, Tcl_ConcatObj(objc - 1, objv + 1));
return TCL_ERROR;
}
/*
|
| ︙ | ︙ | |||
4832 4833 4834 4835 4836 4837 4838 |
return TCL_OK;
}
static int
TestfileCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | > | | 4848 4849 4850 4851 4852 4853 4854 4855 4856 4857 4858 4859 4860 4861 4862 4863 4864 4865 4866 4867 4868 4869 4870 |
return TCL_OK;
}
static int
TestfileCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT argc, /* Number of arguments. */
Tcl_Obj *const argv[]) /* The argument objects. */
{
int force, i, result;
Tcl_Obj *error = NULL;
const char *subcmd;
TclSizeT j;
if (argc + 1 < 4) {
return TCL_ERROR;
}
force = 0;
i = 2;
if (strcmp(Tcl_GetString(argv[2]), "-force") == 0) {
force = 1;
|
| ︙ | ︙ | |||
4914 4915 4916 4917 4918 4919 4920 |
*----------------------------------------------------------------------
*/
static int
TestgetvarfullnameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 |
*----------------------------------------------------------------------
*/
static int
TestgetvarfullnameCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
const char *name, *arg;
int flags = 0;
Tcl_Namespace *namespacePtr;
Tcl_CallFrame *framePtr;
Tcl_Var variable;
|
| ︙ | ︙ | |||
4988 4989 4990 4991 4992 4993 4994 |
*----------------------------------------------------------------------
*/
static int
GetTimesObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The current interpreter. */
| | | 5005 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 |
*----------------------------------------------------------------------
*/
static int
GetTimesObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* The current interpreter. */
TCL_UNUSED(TclSizeT) /*cobjc*/,
TCL_UNUSED(Tcl_Obj *const *) /*cobjv*/)
{
Interp *iPtr = (Interp *) interp;
int i, n;
double timePer;
Tcl_Time start, stop;
Tcl_Obj *objPtr, **objv;
|
| ︙ | ︙ | |||
5194 5195 5196 5197 5198 5199 5200 |
*----------------------------------------------------------------------
*/
static int
NoopObjCmd(
TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
| | | 5211 5212 5213 5214 5215 5216 5217 5218 5219 5220 5221 5222 5223 5224 5225 |
*----------------------------------------------------------------------
*/
static int
NoopObjCmd(
TCL_UNUSED(void *),
TCL_UNUSED(Tcl_Interp *),
TCL_UNUSED(TclSizeT) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
return TCL_OK;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
5219 5220 5221 5222 5223 5224 5225 |
*----------------------------------------------------------------------
*/
static int
TeststringbytesObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 5236 5237 5238 5239 5240 5241 5242 5243 5244 5245 5246 5247 5248 5249 5250 |
*----------------------------------------------------------------------
*/
static int
TeststringbytesObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
int n;
const unsigned char *p;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "value");
|
| ︙ | ︙ | |||
5259 5260 5261 5262 5263 5264 5265 |
*----------------------------------------------------------------------
*/
static int
TestpurebytesobjObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 5276 5277 5278 5279 5280 5281 5282 5283 5284 5285 5286 5287 5288 5289 5290 |
*----------------------------------------------------------------------
*/
static int
TestpurebytesobjObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_Obj *objPtr;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?string?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
5306 5307 5308 5309 5310 5311 5312 |
*----------------------------------------------------------------------
*/
static int
TestsetbytearraylengthObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 5323 5324 5325 5326 5327 5328 5329 5330 5331 5332 5333 5334 5335 5336 5337 |
*----------------------------------------------------------------------
*/
static int
TestsetbytearraylengthObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
int n;
Tcl_Obj *obj = NULL;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "value length");
|
| ︙ | ︙ | |||
5355 5356 5357 5358 5359 5360 5361 |
*----------------------------------------------------------------------
*/
static int
TestbytestringObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 5372 5373 5374 5375 5376 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 |
*----------------------------------------------------------------------
*/
static int
TestbytestringObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
size_t n = 0;
const char *p;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "bytearray");
|
| ︙ | ︙ | |||
5477 5478 5479 5480 5481 5482 5483 |
*----------------------------------------------------------------------
*/
static int
TestsaveresultCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,/* Current interpreter. */
| | | 5494 5495 5496 5497 5498 5499 5500 5501 5502 5503 5504 5505 5506 5507 5508 |
*----------------------------------------------------------------------
*/
static int
TestsaveresultCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,/* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
int discard, result;
Tcl_SavedResult state;
Tcl_Obj *objPtr;
static const char *const optionStrings[] = {
"append", "dynamic", "free", "object", "small", NULL
|
| ︙ | ︙ | |||
6516 6517 6518 6519 6520 6521 6522 |
*----------------------------------------------------------------------
*/
static int
TestWrongNumArgsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | | | 6533 6534 6535 6536 6537 6538 6539 6540 6541 6542 6543 6544 6545 6546 6547 6548 6549 6550 6551 6552 6553 6554 6555 6556 6557 6558 6559 6560 6561 6562 6563 6564 6565 6566 6567 6568 6569 6570 6571 |
*----------------------------------------------------------------------
*/
static int
TestWrongNumArgsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int length, i;
const char *msg;
if (objc + 1 < 4) {
/*
* Don't use Tcl_WrongNumArgs here, as that is the function
* we want to test!
*/
Tcl_AppendResult(interp, "insufficient arguments", NULL);
return TCL_ERROR;
}
if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK) {
return TCL_ERROR;
}
msg = Tcl_GetStringFromObj(objv[2], &length);
if (length == 0) {
msg = NULL;
}
if ((size_t)i + 3 > objc) {
/*
* Asked for more arguments than were given.
*/
Tcl_AppendResult(interp, "insufficient arguments", NULL);
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
6572 6573 6574 6575 6576 6577 6578 |
*----------------------------------------------------------------------
*/
static int
TestGetIndexFromObjStructObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 6589 6590 6591 6592 6593 6594 6595 6596 6597 6598 6599 6600 6601 6602 6603 |
*----------------------------------------------------------------------
*/
static int
TestGetIndexFromObjStructObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *const ary[] = {
"a", "b", "c", "d", "ee", "ff", NULL, NULL
};
int target, flags = 0;
signed char idx[8];
|
| ︙ | ︙ | |||
6634 6635 6636 6637 6638 6639 6640 |
*----------------------------------------------------------------------
*/
static int
TestFilesystemObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 6651 6652 6653 6654 6655 6656 6657 6658 6659 6660 6661 6662 6663 6664 6665 |
*----------------------------------------------------------------------
*/
static int
TestFilesystemObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
TclSizeT objc,
Tcl_Obj *const objv[])
{
int res, boolVal;
const char *msg;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "boolean");
|
| ︙ | ︙ | |||
7005 7006 7007 7008 7009 7010 7011 |
* important features.
*/
static int
TestSimpleFilesystemObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 7022 7023 7024 7025 7026 7027 7028 7029 7030 7031 7032 7033 7034 7035 7036 |
* important features.
*/
static int
TestSimpleFilesystemObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
TclSizeT objc,
Tcl_Obj *const objv[])
{
int res, boolVal;
const char *msg;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "boolean");
|
| ︙ | ︙ | |||
7167 7168 7169 7170 7171 7172 7173 |
* Usage: testutfnext -bytestring $bytes
*/
static int
TestUtfNextCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 7184 7185 7186 7187 7188 7189 7190 7191 7192 7193 7194 7195 7196 7197 7198 |
* Usage: testutfnext -bytestring $bytes
*/
static int
TestUtfNextCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
TclSizeT objc,
Tcl_Obj *const objv[])
{
size_t numBytes;
char *bytes;
const char *result, *first;
char buffer[32];
static const char tobetested[] = "A\xA0\xC0\xC1\xC2\xD0\xE0\xE8\xF2\xF7\xF8\xFE\xFF";
|
| ︙ | ︙ | |||
7229 7230 7231 7232 7233 7234 7235 |
* Usage: testutfprev $bytes $offset
*/
static int
TestUtfPrevCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 7246 7247 7248 7249 7250 7251 7252 7253 7254 7255 7256 7257 7258 7259 7260 |
* Usage: testutfprev $bytes $offset
*/
static int
TestUtfPrevCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
TclSizeT objc,
Tcl_Obj *const objv[])
{
size_t numBytes, offset;
char *bytes;
const char *result;
if (objc < 2 || objc > 3) {
|
| ︙ | ︙ | |||
7270 7271 7272 7273 7274 7275 7276 |
* Used to check correct string-length determining in Tcl_NumUtfChars
*/
static int
TestNumUtfCharsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 7287 7288 7289 7290 7291 7292 7293 7294 7295 7296 7297 7298 7299 7300 7301 |
* Used to check correct string-length determining in Tcl_NumUtfChars
*/
static int
TestNumUtfCharsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
TclSizeT objc,
Tcl_Obj *const objv[])
{
if (objc > 1) {
size_t len, limit = TCL_INDEX_NONE;
const char *bytes = Tcl_GetString(objv[1]);
size_t numBytes = objv[1]->length;
|
| ︙ | ︙ | |||
7300 7301 7302 7303 7304 7305 7306 |
* Used to check correct operation of Tcl_UtfFindFirst
*/
static int
TestFindFirstCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 7317 7318 7319 7320 7321 7322 7323 7324 7325 7326 7327 7328 7329 7330 7331 |
* Used to check correct operation of Tcl_UtfFindFirst
*/
static int
TestFindFirstCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
TclSizeT objc,
Tcl_Obj *const objv[])
{
if (objc > 1) {
int len = -1;
if (objc > 2) {
(void) Tcl_GetIntFromObj(interp, objv[2], &len);
|
| ︙ | ︙ | |||
7322 7323 7324 7325 7326 7327 7328 |
* Used to check correct operation of Tcl_UtfFindLast
*/
static int
TestFindLastCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | | 7339 7340 7341 7342 7343 7344 7345 7346 7347 7348 7349 7350 7351 7352 7353 7354 7355 7356 7357 7358 7359 7360 7361 7362 7363 7364 7365 7366 7367 7368 7369 7370 7371 |
* Used to check correct operation of Tcl_UtfFindLast
*/
static int
TestFindLastCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
TclSizeT objc,
Tcl_Obj *const objv[])
{
if (objc > 1) {
int len = -1;
if (objc > 2) {
(void) Tcl_GetIntFromObj(interp, objv[2], &len);
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), -1));
}
return TCL_OK;
}
static int
TestGetIntForIndexCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
TclSizeT objc,
Tcl_Obj *const objv[])
{
size_t result;
Tcl_WideInt endvalue;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "index endvalue");
|
| ︙ | ︙ | |||
7392 7393 7394 7395 7396 7397 7398 |
*----------------------------------------------------------------------
*/
static int
TestcpuidCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
| | | 7409 7410 7411 7412 7413 7414 7415 7416 7417 7418 7419 7420 7421 7422 7423 |
*----------------------------------------------------------------------
*/
static int
TestcpuidCmd(
TCL_UNUSED(void *),
Tcl_Interp* interp, /* Tcl interpreter */
TclSizeT objc, /* Parameter count */
Tcl_Obj *const * objv) /* Parameter vector */
{
int status, index, i;
int regs[4];
Tcl_Obj *regsObjs[4];
if (objc != 2) {
|
| ︙ | ︙ | |||
7428 7429 7430 7431 7432 7433 7434 |
* Used to do basic checks of the TCL_HASH_KEY_SYSTEM_HASH flag
*/
static int
TestHashSystemHashCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 7445 7446 7447 7448 7449 7450 7451 7452 7453 7454 7455 7456 7457 7458 7459 |
* Used to do basic checks of the TCL_HASH_KEY_SYSTEM_HASH flag
*/
static int
TestHashSystemHashCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
TclSizeT objc,
Tcl_Obj *const objv[])
{
static const Tcl_HashKeyType hkType = {
TCL_HASH_KEY_TYPE_VERSION, TCL_HASH_KEY_SYSTEM_HASH,
NULL, NULL, NULL, NULL
};
Tcl_HashTable hash;
|
| ︙ | ︙ | |||
7573 7574 7575 7576 7577 7578 7579 |
return TCL_OK;
}
static int
TestNREUnwind(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | | 7590 7591 7592 7593 7594 7595 7596 7597 7598 7599 7600 7601 7602 7603 7604 7605 7606 7607 7608 7609 7610 7611 7612 7613 7614 7615 7616 7617 7618 7619 7620 7621 7622 |
return TCL_OK;
}
static int
TestNREUnwind(
TCL_UNUSED(void *),
Tcl_Interp *interp,
TCL_UNUSED(TclSizeT) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
/*
* Insure that callbacks effectively run at the proper level during the
* unwinding of the NRE stack.
*/
Tcl_NRAddCallback(interp, NREUnwind_callback, INT2PTR(-1), INT2PTR(-1),
INT2PTR(-1), NULL);
return TCL_OK;
}
static int
TestNRELevels(
TCL_UNUSED(void *),
Tcl_Interp *interp,
TCL_UNUSED(TclSizeT) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
Interp *iPtr = (Interp *) interp;
static ptrdiff_t *refDepth = NULL;
ptrdiff_t depth;
Tcl_Obj *levels[6];
size_t i = 0;
|
| ︙ | ︙ | |||
7937 7938 7939 7940 7941 7942 7943 |
*----------------------------------------------------------------------
*/
static int
TestgetencpathObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 7954 7955 7956 7957 7958 7959 7960 7961 7962 7963 7964 7965 7966 7967 7968 |
*----------------------------------------------------------------------
*/
static int
TestgetencpathObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
7970 7971 7972 7973 7974 7975 7976 |
*----------------------------------------------------------------------
*/
static int
TestsetencpathObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 7987 7988 7989 7990 7991 7992 7993 7994 7995 7996 7997 7998 7999 8000 8001 |
*----------------------------------------------------------------------
*/
static int
TestsetencpathObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "defaultDir");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
8004 8005 8006 8007 8008 8009 8010 |
*----------------------------------------------------------------------
*/
static int
TestparseargsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | 8021 8022 8023 8024 8025 8026 8027 8028 8029 8030 8031 8032 8033 8034 8035 |
*----------------------------------------------------------------------
*/
static int
TestparseargsCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TclSizeT objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Arguments. */
{
static int foo = 0;
int count = objc;
Tcl_Obj **remObjv, *result[3];
Tcl_ArgvInfo argTable[] = {
{TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL},
|
| ︙ | ︙ | |||
8243 8244 8245 8246 8247 8248 8249 |
return TCL_CONTINUE;
}
static int
TestInterpResolverCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
| | | 8260 8261 8262 8263 8264 8265 8266 8267 8268 8269 8270 8271 8272 8273 8274 |
return TCL_CONTINUE;
}
static int
TestInterpResolverCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
TclSizeT objc,
Tcl_Obj *const objv[])
{
static const char *const table[] = {
"down", "up", NULL
};
int idx;
#define RESOLVER_KEY "testInterpResolver"
|
| ︙ | ︙ | |||
8305 8306 8307 8308 8309 8310 8311 |
* Interpreter result holds result or error message.
*
*------------------------------------------------------------------------
*/
int TestApplyLambdaObjCmd (
TCL_UNUSED(void*),
Tcl_Interp *interp, /* Current interpreter. */
| | | 8322 8323 8324 8325 8326 8327 8328 8329 8330 8331 8332 8333 8334 8335 8336 |
* Interpreter result holds result or error message.
*
*------------------------------------------------------------------------
*/
int TestApplyLambdaObjCmd (
TCL_UNUSED(void*),
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(TclSizeT), /* objc. */
TCL_UNUSED(Tcl_Obj *const *)) /* objv. */
{
Tcl_Obj *lambdaObjs[2];
Tcl_Obj *evalObjs[2];
Tcl_Obj *lambdaObj;
int result;
|
| ︙ | ︙ |
Changes to generic/tclTestObj.c.
| ︙ | ︙ | |||
30 31 32 33 34 35 36 | * Forward declarations for functions defined later in this file: */ static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, size_t varIndex); static int GetVariableIndex(Tcl_Interp *interp, Tcl_Obj *obj, size_t *indexPtr); static void SetVarToObj(Tcl_Obj **varPtr, size_t varIndex, Tcl_Obj *objPtr); | | | | | | | | | | 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 |
* Forward declarations for functions defined later in this file:
*/
static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, size_t varIndex);
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_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
static void VarPtrDeleteProc(void *clientData, TCL_UNUSED(Tcl_Interp *))
{
int i;
|
| ︙ | ︙ | |||
98 99 100 101 102 103 104 |
return TCL_ERROR;
}
Tcl_SetAssocData(interp, VARPTR_KEY, VarPtrDeleteProc, varPtr);
for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) {
varPtr[i] = NULL;
}
| | | | | | | | | | 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 |
return TCL_ERROR;
}
Tcl_SetAssocData(interp, VARPTR_KEY, VarPtrDeleteProc, varPtr);
for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) {
varPtr[i] = NULL;
}
Tcl_CreateObjCommand2(interp, "testbignumobj", TestbignumobjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testbooleanobj", TestbooleanobjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testdoubleobj", TestdoubleobjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testintobj", TestintobjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testindexobj", TestindexobjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testlistobj", TestlistobjCmd,
NULL, NULL);
Tcl_CreateObjCommand2(interp, "testobj", TestobjCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "teststringobj", TeststringobjCmd,
NULL, NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
138 139 140 141 142 143 144 |
*----------------------------------------------------------------------
*/
static int
TestbignumobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
| | | | 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 |
*----------------------------------------------------------------------
*/
static int
TestbignumobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
size_t objc, /* Argument count */
Tcl_Obj *const objv[]) /* Argument vector */
{
const char *const subcmds[] = {
"set", "get", "mult10", "div10", "iseven", "radixsize", NULL
};
enum options {
BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10, BIGNUM_ISEVEN,
BIGNUM_RADIXSIZE
} idx;
int index;
size_t varIndex;
const char *string;
mp_int bignumValue;
Tcl_Obj **varPtr;
if (objc + 1 < 4) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0,
&idx) != TCL_OK) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
337 338 339 340 341 342 343 |
*----------------------------------------------------------------------
*/
static int
TestbooleanobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 |
*----------------------------------------------------------------------
*/
static int
TestbooleanobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
size_t varIndex;
int boolValue;
const char *subCmd;
Tcl_Obj **varPtr;
if (objc + 1 < 4) {
wrongNumArgs:
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
return TCL_ERROR;
}
if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
|
| ︙ | ︙ | |||
437 438 439 440 441 442 443 |
*----------------------------------------------------------------------
*/
static int
TestdoubleobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 |
*----------------------------------------------------------------------
*/
static int
TestdoubleobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
size_t varIndex;
double doubleValue;
const char *subCmd;
Tcl_Obj **varPtr;
if (objc + 1 < 4) {
wrongNumArgs:
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
return TCL_ERROR;
}
varPtr = GetVarPtr(interp);
|
| ︙ | ︙ | |||
553 554 555 556 557 558 559 |
*----------------------------------------------------------------------
*/
static int
TestindexobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | > | 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 |
*----------------------------------------------------------------------
*/
static int
TestindexobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int allowAbbrev, index, setError, result;
size_t i;
Tcl_WideInt index2;
const char **argv;
static const char *const tablePtr[] = {"a", "b", "check", NULL};
/*
* Keep this structure declaration in sync with tclIndexObj.c
*/
|
| ︙ | ︙ | |||
593 594 595 596 597 598 599 |
tablePtr, "token", 0, &index);
if (result == TCL_OK) {
Tcl_SetWideIntObj(Tcl_GetObjResult(interp), index);
}
return result;
}
| | | 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 |
tablePtr, "token", 0, &index);
if (result == TCL_OK) {
Tcl_SetWideIntObj(Tcl_GetObjResult(interp), index);
}
return result;
}
if (objc + 1 < 6) {
Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args", -1);
return TCL_ERROR;
}
if (Tcl_GetBooleanFromObj(interp, objv[1], &setError) != TCL_OK) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
643 644 645 646 647 648 649 |
*----------------------------------------------------------------------
*/
static int
TestintobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 |
*----------------------------------------------------------------------
*/
static int
TestintobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
size_t varIndex;
#if (INT_MAX != LONG_MAX) /* int is not the same size as long */
int i;
#endif
Tcl_WideInt wideValue;
const char *subCmd;
Tcl_Obj **varPtr;
if (objc + 1 < 4) {
wrongNumArgs:
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
return TCL_ERROR;
}
varPtr = GetVarPtr(interp);
if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
|
| ︙ | ︙ | |||
842 843 844 845 846 847 848 |
*-----------------------------------------------------------------------------
*/
static int
TestlistobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
| | | | 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 |
*-----------------------------------------------------------------------------
*/
static int
TestlistobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
size_t objc, /* Number of arguments */
Tcl_Obj *const objv[]) /* Argument objects */
{
/* Subcommands supported by this command */
const char* subcommands[] = {
"set",
"get",
"replace"
};
enum listobjCmdIndex {
LISTOBJ_SET,
LISTOBJ_GET,
LISTOBJ_REPLACE
} cmdIndex;
size_t varIndex; /* Variable number converted to binary */
Tcl_WideInt first; /* First index in the list */
Tcl_WideInt count; /* Count of elements in a list */
Tcl_Obj **varPtr;
if (objc + 1 < 4) {
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg...?");
return TCL_ERROR;
}
varPtr = GetVarPtr(interp);
if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
936 937 938 939 940 941 942 |
*----------------------------------------------------------------------
*/
static int
TestobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 |
*----------------------------------------------------------------------
*/
static int
TestobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
size_t varIndex, destIndex;
int i;
const char *subCmd;
const Tcl_ObjType *targetType;
Tcl_Obj **varPtr;
if (objc + 1 < 3) {
wrongNumArgs:
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
return TCL_ERROR;
}
varPtr = GetVarPtr(interp);
subCmd = Tcl_GetString(objv[1]);
|
| ︙ | ︙ | |||
1138 1139 1140 1141 1142 1143 1144 |
*----------------------------------------------------------------------
*/
static int
TeststringobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | | | 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 |
*----------------------------------------------------------------------
*/
static int
TeststringobjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_UniChar *unicode;
size_t size, varIndex, i;
int option;
Tcl_WideInt length;
#define MAX_STRINGS 11
const char *string, *strings[MAX_STRINGS+1];
String *strPtr;
Tcl_Obj **varPtr;
static const char *const options[] = {
"append", "appendstrings", "get", "get2", "length", "length2",
"set", "set2", "setlength", "maxchars", "range", "appendself",
"appendself2", NULL
};
if (objc + 1 < 4) {
wrongNumArgs:
Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
return TCL_ERROR;
}
varPtr = GetVarPtr(interp);
if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
|
| ︙ | ︙ |
Changes to generic/tclTestProcBodyObj.c.
| ︙ | ︙ | |||
33 34 35 36 37 38 39 |
/*
* this struct describes an entry in the table of command names and command
* procs
*/
typedef struct {
const char *cmdName; /* command name */
| | | | | 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 |
/*
* this struct describes an entry in the table of command names and command
* procs
*/
typedef struct {
const char *cmdName; /* command name */
Tcl_ObjCmdProc2 *proc; /* command proc */
int exportIt; /* if 1, export the command */
} CmdTable;
/*
* Declarations for functions defined in this file.
*/
static int ProcBodyTestProcObjCmd(void *dummy,
Tcl_Interp *interp, size_t objc, Tcl_Obj *const objv[]);
static int ProcBodyTestCheckObjCmd(void *dummy,
Tcl_Interp *interp, size_t objc, Tcl_Obj *const objv[]);
static int ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe);
static int RegisterCommand(Tcl_Interp* interp,
const char *namesp, const CmdTable *cmdTablePtr);
/*
* List of commands to create when the package is loaded; must go after the
* declarations of the enable command procedure.
|
| ︙ | ︙ | |||
150 151 152 153 154 155 156 |
namesp, cmdTablePtr->cmdName);
if (Tcl_EvalEx(interp, buf, -1, 0) != TCL_OK) {
return TCL_ERROR;
}
}
sprintf(buf, "%s::%s", namesp, cmdTablePtr->cmdName);
| | | 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 |
namesp, cmdTablePtr->cmdName);
if (Tcl_EvalEx(interp, buf, -1, 0) != TCL_OK) {
return TCL_ERROR;
}
}
sprintf(buf, "%s::%s", namesp, cmdTablePtr->cmdName);
Tcl_CreateObjCommand2(interp, buf, cmdTablePtr->proc, 0, 0);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ProcBodyTestInitInternal --
|
| ︙ | ︙ | |||
226 227 228 229 230 231 232 |
*----------------------------------------------------------------------
*/
static int
ProcBodyTestProcObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* the current interpreter */
| | | 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 |
*----------------------------------------------------------------------
*/
static int
ProcBodyTestProcObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* the current interpreter */
size_t objc, /* argument count */
Tcl_Obj *const objv[]) /* arguments */
{
const char *fullName;
Tcl_Command procCmd;
Command *cmdPtr;
Proc *procPtr = NULL;
Tcl_Obj *bodyObjPtr;
|
| ︙ | ︙ | |||
325 326 327 328 329 330 331 |
*----------------------------------------------------------------------
*/
static int
ProcBodyTestCheckObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* the current interpreter */
| | | 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 |
*----------------------------------------------------------------------
*/
static int
ProcBodyTestCheckObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* the current interpreter */
size_t objc, /* argument count */
Tcl_Obj *const objv[]) /* arguments */
{
const char *version;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
|
| ︙ | ︙ |
Changes to generic/tclThreadTest.c.
| ︙ | ︙ | |||
116 117 118 119 120 121 122 | * Access to the list of threads and to the thread send results is guarded by * this mutex. */ TCL_DECLARE_MUTEX(threadMutex) static int ThreadObjCmd(void *clientData, | | | 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 | * Access to the list of threads and to the thread send results is guarded by * this mutex. */ TCL_DECLARE_MUTEX(threadMutex) static int ThreadObjCmd(void *clientData, Tcl_Interp *interp, size_t objc, Tcl_Obj *const objv[]); static int ThreadCreate(Tcl_Interp *interp, const char *script, int joinable); static int ThreadList(Tcl_Interp *interp); static int ThreadSend(Tcl_Interp *interp, Tcl_ThreadId id, const char *script, int wait); static int ThreadCancel(Tcl_Interp *interp, Tcl_ThreadId id, |
| ︙ | ︙ | |||
167 168 169 170 171 172 173 |
Tcl_MutexLock(&threadMutex);
if (mainThreadId == 0) {
mainThreadId = Tcl_GetCurrentThread();
}
Tcl_MutexUnlock(&threadMutex);
| | | 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 |
Tcl_MutexLock(&threadMutex);
if (mainThreadId == 0) {
mainThreadId = Tcl_GetCurrentThread();
}
Tcl_MutexUnlock(&threadMutex);
Tcl_CreateObjCommand2(interp, "testthread", ThreadObjCmd, NULL, NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ThreadObjCmd --
|
| ︙ | ︙ | |||
203 204 205 206 207 208 209 |
*----------------------------------------------------------------------
*/
static int
ThreadObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 |
*----------------------------------------------------------------------
*/
static int
ThreadObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
static const char *const threadOptions[] = {
"cancel", "create", "event", "exit", "id",
"join", "names", "send", "wait", "errorproc",
NULL
};
enum options {
THREAD_CANCEL, THREAD_CREATE, THREAD_EVENT, THREAD_EXIT,
THREAD_ID, THREAD_JOIN, THREAD_NAMES, THREAD_SEND,
THREAD_WAIT, THREAD_ERRORPROC
} option;
if (objc + 1 < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions, "option", 0,
&option) != TCL_OK) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
243 244 245 246 247 248 249 |
Tcl_MutexUnlock(&threadMutex);
}
switch (option) {
case THREAD_CANCEL: {
Tcl_WideInt id;
const char *result;
| | > | 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 |
Tcl_MutexUnlock(&threadMutex);
}
switch (option) {
case THREAD_CANCEL: {
Tcl_WideInt id;
const char *result;
int flags;
size_t arg;
if ((objc < 3) || (objc > 5)) {
Tcl_WrongNumArgs(interp, 2, objv, "?-unwind? id ?result?");
return TCL_ERROR;
}
flags = 0;
arg = 2;
|
| ︙ | ︙ |
Changes to generic/tclTrace.c.
| ︙ | ︙ | |||
2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 |
*
* When the trace is deleted, the 'delProc' function will be invoked,
* passing it the original client data.
*
*----------------------------------------------------------------------
*/
typedef struct {
Tcl_CmdObjTraceProc *proc;
Tcl_CmdObjTraceDeleteProc *delProc;
void *clientData;
} TraceWrapperInfo;
static int traceWrapperProc(
| > | 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 |
*
* When the trace is deleted, the 'delProc' function will be invoked,
* passing it the original client data.
*
*----------------------------------------------------------------------
*/
#ifndef TCL_NO_DEPRECATED
typedef struct {
Tcl_CmdObjTraceProc *proc;
Tcl_CmdObjTraceDeleteProc *delProc;
void *clientData;
} TraceWrapperInfo;
static int traceWrapperProc(
|
| ︙ | ︙ | |||
2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 |
info->proc = proc;
info->delProc = delProc;
info->clientData = clientData;
return Tcl_CreateObjTrace2(interp, level, flags,
(proc ? traceWrapperProc : NULL),
info, traceWrapperDelProc);
}
Tcl_Trace
Tcl_CreateObjTrace2(
Tcl_Interp *interp, /* Tcl interpreter */
int level, /* Maximum nesting level */
int flags, /* Flags, see above */
Tcl_CmdObjTraceProc2 *proc, /* Trace callback */
| > | 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 |
info->proc = proc;
info->delProc = delProc;
info->clientData = clientData;
return Tcl_CreateObjTrace2(interp, level, flags,
(proc ? traceWrapperProc : NULL),
info, traceWrapperDelProc);
}
#endif /* TCL_NO_DEPRECATED */
Tcl_Trace
Tcl_CreateObjTrace2(
Tcl_Interp *interp, /* Tcl interpreter */
int level, /* Maximum nesting level */
int flags, /* Flags, see above */
Tcl_CmdObjTraceProc2 *proc, /* Trace callback */
|
| ︙ | ︙ |
Changes to unix/dltest/pkga.c.
| ︙ | ︙ | |||
31 32 33 34 35 36 37 |
*----------------------------------------------------------------------
*/
static int
Pkga_EqObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 |
*----------------------------------------------------------------------
*/
static int
Pkga_EqObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int result;
const char *str1, *str2;
size_t len1, len2;
(void)dummy;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "string1 string2");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
76 77 78 79 80 81 82 |
*----------------------------------------------------------------------
*/
static int
Pkga_QuoteObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 |
*----------------------------------------------------------------------
*/
static int
Pkga_QuoteObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument strings. */
{
(void)dummy;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "value");
return TCL_ERROR;
|
| ︙ | ︙ | |||
120 121 122 123 124 125 126 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkga", "1.0");
if (code != TCL_OK) {
return code;
}
| | | | 120 121 122 123 124 125 126 127 128 129 130 131 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkga", "1.0");
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand2(interp, "pkga_eq", Pkga_EqObjCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "pkga_quote", Pkga_QuoteObjCmd, NULL,
NULL);
return TCL_OK;
}
|
Changes to unix/dltest/pkgb.c.
| ︙ | ︙ | |||
31 32 33 34 35 36 37 |
*----------------------------------------------------------------------
*/
static int
Pkgb_SubObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 |
*----------------------------------------------------------------------
*/
static int
Pkgb_SubObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int first, second;
(void)dummy;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "num num");
|
| ︙ | ︙ | |||
73 74 75 76 77 78 79 |
*----------------------------------------------------------------------
*/
static int
Pkgb_UnsafeObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | | 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 |
*----------------------------------------------------------------------
*/
static int
Pkgb_UnsafeObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
(void)dummy;
(void)objc;
(void)objv;
return Tcl_EvalEx(interp, "list unsafe command invoked", -1, TCL_EVAL_GLOBAL);
}
static int
Pkgb_DemoObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_WideInt numChars;
int result;
(void)dummy;
if (objc != 4) {
|
| ︙ | ︙ | |||
137 138 139 140 141 142 143 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgb", "2.3");
if (code != TCL_OK) {
return code;
}
| | | | | 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgb", "2.3");
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand2(interp, "pkgb_sub", Pkgb_SubObjCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "pkgb_demo", Pkgb_DemoObjCmd, NULL, NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* Pkgb_SafeInit --
|
| ︙ | ︙ | |||
174 175 176 177 178 179 180 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgb", "2.3");
if (code != TCL_OK) {
return code;
}
| | | 174 175 176 177 178 179 180 181 182 183 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgb", "2.3");
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand2(interp, "pkgb_sub", Pkgb_SubObjCmd, NULL, NULL);
return TCL_OK;
}
|
Changes to unix/dltest/pkgc.c.
| ︙ | ︙ | |||
31 32 33 34 35 36 37 |
*----------------------------------------------------------------------
*/
static int
Pkgc_SubObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 |
*----------------------------------------------------------------------
*/
static int
Pkgc_SubObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int first, second;
(void)dummy;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "num num");
|
| ︙ | ︙ | |||
70 71 72 73 74 75 76 |
*----------------------------------------------------------------------
*/
static int
Pkgc_UnsafeObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 |
*----------------------------------------------------------------------
*/
static int
Pkgc_UnsafeObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
(void)dummy;
(void)objc;
(void)objv;
Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
|
| ︙ | ︙ | |||
112 113 114 115 116 117 118 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgc", "1.7.2");
if (code != TCL_OK) {
return code;
}
| | | | 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgc", "1.7.2");
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand2(interp, "pkgc_sub", Pkgc_SubObjCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "pkgc_unsafe", Pkgc_UnsafeObjCmd, NULL,
NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
149 150 151 152 153 154 155 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgc", "1.7.2");
if (code != TCL_OK) {
return code;
}
| | | 149 150 151 152 153 154 155 156 157 158 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgc", "1.7.2");
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand2(interp, "pkgc_sub", Pkgc_SubObjCmd, NULL, NULL);
return TCL_OK;
}
|
Changes to unix/dltest/pkgd.c.
| ︙ | ︙ | |||
31 32 33 34 35 36 37 |
*----------------------------------------------------------------------
*/
static int
Pkgd_SubObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 |
*----------------------------------------------------------------------
*/
static int
Pkgd_SubObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int first, second;
(void)dummy;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "num num");
|
| ︙ | ︙ | |||
70 71 72 73 74 75 76 |
*----------------------------------------------------------------------
*/
static int
Pkgd_UnsafeObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 |
*----------------------------------------------------------------------
*/
static int
Pkgd_UnsafeObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
(void)dummy;
(void)objc;
(void)objv;
Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1));
|
| ︙ | ︙ | |||
112 113 114 115 116 117 118 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgd", "7.3");
if (code != TCL_OK) {
return code;
}
| | | | 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgd", "7.3");
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand2(interp, "pkgd_sub", Pkgd_SubObjCmd, NULL, NULL);
Tcl_CreateObjCommand2(interp, "pkgd_unsafe", Pkgd_UnsafeObjCmd, NULL,
NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
149 150 151 152 153 154 155 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgd", "7.3");
if (code != TCL_OK) {
return code;
}
| | | 149 150 151 152 153 154 155 156 157 158 |
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "pkgd", "7.3");
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand2(interp, "pkgd_sub", Pkgd_SubObjCmd, NULL, NULL);
return TCL_OK;
}
|
Changes to unix/dltest/pkgooa.c.
| ︙ | ︙ | |||
31 32 33 34 35 36 37 |
*----------------------------------------------------------------------
*/
static int
Pkgooa_StubsOKObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 |
*----------------------------------------------------------------------
*/
static int
Pkgooa_StubsOKObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
(void)dummy;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
|
| ︙ | ︙ | |||
147 148 149 150 151 152 153 |
tclOOStubsPtr = &stubsCopy;
code = Tcl_PkgProvide(interp, "pkgooa", "1.0");
if (code != TCL_OK) {
return code;
}
| | | 147 148 149 150 151 152 153 154 155 156 |
tclOOStubsPtr = &stubsCopy;
code = Tcl_PkgProvide(interp, "pkgooa", "1.0");
if (code != TCL_OK) {
return code;
}
Tcl_CreateObjCommand2(interp, "pkgooa_stubsok", Pkgooa_StubsOKObjCmd, NULL, NULL);
return TCL_OK;
}
|
Changes to unix/dltest/pkgua.c.
| ︙ | ︙ | |||
118 119 120 121 122 123 124 |
*----------------------------------------------------------------------
*/
static int
PkguaEqObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 |
*----------------------------------------------------------------------
*/
static int
PkguaEqObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int result;
const char *str1, *str2;
int len1, len2;
(void)dummy;
|
| ︙ | ︙ | |||
163 164 165 166 167 168 169 |
*----------------------------------------------------------------------
*/
static int
PkguaQuoteObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
| | | 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 |
*----------------------------------------------------------------------
*/
static int
PkguaQuoteObjCmd(
void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument strings. */
{
(void)dummy;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "value");
return TCL_ERROR;
|
| ︙ | ︙ | |||
221 222 223 224 225 226 227 |
return code;
}
Tcl_SetVar2(interp, "::pkgua_loaded", NULL, ".", TCL_APPEND_VALUE);
cmdTokens = PkguaInterpToTokens(interp);
cmdTokens[0] =
| | | | 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 |
return code;
}
Tcl_SetVar2(interp, "::pkgua_loaded", NULL, ".", TCL_APPEND_VALUE);
cmdTokens = PkguaInterpToTokens(interp);
cmdTokens[0] =
Tcl_CreateObjCommand2(interp, "pkgua_eq", PkguaEqObjCmd, &cmdTokens[0],
CommandDeleted);
cmdTokens[1] =
Tcl_CreateObjCommand2(interp, "pkgua_quote", PkguaQuoteObjCmd,
&cmdTokens[1], CommandDeleted);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ |
Changes to unix/tclXtTest.c.
| ︙ | ︙ | |||
11 12 13 14 15 16 17 | #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include <X11/Intrinsic.h> #include "tcl.h" | | | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include <X11/Intrinsic.h> #include "tcl.h" static Tcl_ObjCmdProc2 TesteventloopCmd; /* * Functions defined in tclXtNotify.c for use by users of the Xt Notifier: */ extern void InitNotifier(void); extern XtAppContext TclSetAppContext(XtAppContext ctx); |
| ︙ | ︙ | |||
48 49 50 51 52 53 54 |
Tcl_Interp *interp) /* Interpreter for application. */
{
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
XtToolkitInitialize();
InitNotifier();
| | | 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 |
Tcl_Interp *interp) /* Interpreter for application. */
{
if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
XtToolkitInitialize();
InitNotifier();
Tcl_CreateObjCommand2(interp, "testeventloop", TesteventloopCmd,
NULL, NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
75 76 77 78 79 80 81 |
*----------------------------------------------------------------------
*/
static int
TesteventloopCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp, /* Current interpreter. */
| | | | 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 |
*----------------------------------------------------------------------
*/
static int
TesteventloopCmd(
TCL_UNUSED(ClientData),
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static int *framePtr = NULL;/* Pointer to integer on stack frame of
* innermost invocation of the "wait"
* subcommand. */
if (objc + 1 < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "option ...");
return TCL_ERROR;
}
if (strcmp(Tcl_GetString(objv[1]), "done") == 0) {
*framePtr = 1;
} else if (strcmp(Tcl_GetString(objv[1]), "wait") == 0) {
int *oldFramePtr;
|
| ︙ | ︙ |