diff options
| -rw-r--r-- | doc/CrtAlias.3 | 23 | ||||
| -rw-r--r-- | generic/tcl.decls | 17 | ||||
| -rw-r--r-- | generic/tcl.h | 4 | ||||
| -rw-r--r-- | generic/tclDecls.h | 48 | ||||
| -rw-r--r-- | generic/tclInterp.c | 154 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 24 |
6 files changed, 111 insertions, 159 deletions
diff --git a/doc/CrtAlias.3 b/doc/CrtAlias.3 index e58d159..ba2e415 100644 --- a/doc/CrtAlias.3 +++ b/doc/CrtAlias.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_IsSafe, Tcl_CreateChild, Tcl_GetChild, Tcl_GetParent, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands +Tcl_IsSafe, Tcl_CreateChild, Tcl_GetChild, Tcl_GetParent, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -37,10 +37,6 @@ int objc, objv\fR) .sp int -\fBTcl_GetAlias\fR(\fIinterp, childCmd, targetInterpPtr, targetCmdPtr, - argcPtr, argvPtr\fR) -.sp -int \fBTcl_GetAliasObj\fR(\fIinterp, childCmd, targetInterpPtr, targetCmdPtr, objcPtr, objvPtr\fR) .sp @@ -87,16 +83,13 @@ command is defined for an alias. .AP "const char" **targetCmdPtr out Pointer to location to store the address of the name of the target command for an alias. -.AP int *argcPtr out -Pointer to location to store count of additional arguments to be passed to -the alias. The location is in storage owned by the caller. -.AP "const char" ***argvPtr out -Pointer to location to store a vector of strings, the additional arguments -to pass to an alias. The location is in storage owned by the caller, the -vector of strings is owned by the called function. -.AP int *objcPtr out +.AP "Tcl_Size \&| int" *objcPtr out Pointer to location to store count of additional value arguments to be passed to the alias. The location is in storage owned by the caller. +If it points to a variable which type is not \fBTcl_Size\fR, a compiler +warning will be generated. If your extensions is compiled with -DTCL_8_API, +this function will return TCL_ERROR for aliases with more than INT_MAX +value arguments, otherwise expect it to crash .AP Tcl_Obj ***objvPtr out Pointer to location to store a vector of Tcl_Obj structures, the additional arguments to pass to an alias command. The location is in storage @@ -176,10 +169,6 @@ non\-\fBNULL\fR, the address indicated is set to the corresponding datum. For example, if \fItargetCmdPtr\fR is non\-\fBNULL\fR it is set to a pointer to the string containing the name of the target command. .PP -\fBTcl_GetAlias\fR is similar to \fBTcl_GetAliasObj\fR except that it -returns a pointer to a vector of string instead of a vector of -Tcl_Obj structures. \fBTcl_GetAlias\fR is deprecated. -.PP \fBTcl_ExposeCommand\fR moves the command named \fIhiddenCmdName\fR from the set of hidden commands to the set of exposed commands, putting it under the name diff --git a/generic/tcl.decls b/generic/tcl.decls index 5650967..41fe5f3 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -470,15 +470,10 @@ declare 145 { declare 146 { int Tcl_Flush(Tcl_Channel chan) } -declare 148 {deprecated {Use Tcl_GetAliasObj}} { - int Tcl_GetAlias(Tcl_Interp *interp, const char *childCmd, - Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, - int *argcPtr, const char ***argvPtr) -} declare 149 { - int Tcl_GetAliasObj(Tcl_Interp *interp, const char *childCmd, + int TclGetAliasObj(Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, - int *objcPtr, Tcl_Obj ***objv) + int *objcPtr, Tcl_Obj ***objvPtr) } declare 150 { void *Tcl_GetAssocData(Tcl_Interp *interp, const char *name, @@ -880,9 +875,11 @@ declare 284 { void Tcl_SetMainLoop(Tcl_MainLoopProc *proc) } -# Reserved for future use (8.0.x vs. 8.1) -# declare 285 { -# } +declare 285 { + int Tcl_GetAliasObj(Tcl_Interp *interp, const char *childCmd, + Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, + Tcl_Size *objcPtr, Tcl_Obj ***objvPtr) +} # Added in 8.1: diff --git a/generic/tcl.h b/generic/tcl.h index 6053a7e..d339b8f 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2337,8 +2337,8 @@ void * TclStubCall(void *arg); TCL_STUB_MAGIC) #else # define Tcl_InitStubs(interp, version, exact) \ - (Tcl_InitStubs)(interp, TCL_PATCH_LEVEL, \ - 1|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \ + (Tcl_InitStubs)(interp, (((exact)&1) ? (version) : "9.0b2"), \ + (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \ TCL_STUB_MAGIC) #endif #else diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 896deed..c786392 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -427,19 +427,13 @@ EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, /* 146 */ EXTERN int Tcl_Flush(Tcl_Channel chan); /* Slot 147 is reserved */ -/* 148 */ -TCL_DEPRECATED("Use Tcl_GetAliasObj") -int Tcl_GetAlias(Tcl_Interp *interp, - const char *childCmd, - Tcl_Interp **targetInterpPtr, - const char **targetCmdPtr, int *argcPtr, - const char ***argvPtr); +/* Slot 148 is reserved */ /* 149 */ -EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp, +EXTERN int TclGetAliasObj(Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, - Tcl_Obj ***objv); + Tcl_Obj ***objvPtr); /* 150 */ EXTERN void * Tcl_GetAssocData(Tcl_Interp *interp, const char *name, @@ -762,7 +756,12 @@ EXTERN int Tcl_UnstackChannel(Tcl_Interp *interp, EXTERN Tcl_Channel Tcl_GetStackedChannel(Tcl_Channel chan); /* 284 */ EXTERN void Tcl_SetMainLoop(Tcl_MainLoopProc *proc); -/* Slot 285 is reserved */ +/* 285 */ +EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp, + const char *childCmd, + Tcl_Interp **targetInterpPtr, + const char **targetCmdPtr, Tcl_Size *objcPtr, + Tcl_Obj ***objvPtr); /* 286 */ EXTERN void Tcl_AppendObjToObj(Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); @@ -2033,8 +2032,8 @@ typedef struct TclStubs { Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */ int (*tcl_Flush) (Tcl_Channel chan); /* 146 */ void (*reserved147)(void); - TCL_DEPRECATED_API("Use Tcl_GetAliasObj") int (*tcl_GetAlias) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */ - int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */ + void (*reserved148)(void); + int (*tclGetAliasObj) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 149 */ void * (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */ Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */ Tcl_Size (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */ @@ -2170,7 +2169,7 @@ typedef struct TclStubs { int (*tcl_UnstackChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 282 */ Tcl_Channel (*tcl_GetStackedChannel) (Tcl_Channel chan); /* 283 */ void (*tcl_SetMainLoop) (Tcl_MainLoopProc *proc); /* 284 */ - void (*reserved285)(void); + int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr); /* 285 */ void (*tcl_AppendObjToObj) (Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 286 */ Tcl_Encoding (*tcl_CreateEncoding) (const Tcl_EncodingType *typePtr); /* 287 */ void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 288 */ @@ -2868,10 +2867,9 @@ extern const TclStubs *tclStubsPtr; #define Tcl_Flush \ (tclStubsPtr->tcl_Flush) /* 146 */ /* Slot 147 is reserved */ -#define Tcl_GetAlias \ - (tclStubsPtr->tcl_GetAlias) /* 148 */ -#define Tcl_GetAliasObj \ - (tclStubsPtr->tcl_GetAliasObj) /* 149 */ +/* Slot 148 is reserved */ +#define TclGetAliasObj \ + (tclStubsPtr->tclGetAliasObj) /* 149 */ #define Tcl_GetAssocData \ (tclStubsPtr->tcl_GetAssocData) /* 150 */ #define Tcl_GetChannel \ @@ -3116,7 +3114,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetStackedChannel) /* 283 */ #define Tcl_SetMainLoop \ (tclStubsPtr->tcl_SetMainLoop) /* 284 */ -/* Slot 285 is reserved */ +#define Tcl_GetAliasObj \ + (tclStubsPtr->tcl_GetAliasObj) /* 285 */ #define Tcl_AppendObjToObj \ (tclStubsPtr->tcl_AppendObjToObj) /* 286 */ #define Tcl_CreateEncoding \ @@ -4170,7 +4169,7 @@ extern const TclStubs *tclStubsPtr; # define Tcl_GetMaster Tcl_GetParent #endif -/* Protect those 10 functions, make them useless through the stub table */ +/* Protect those 11 functions, make them useless through the stub table */ #undef TclGetStringFromObj #undef TclGetBytesFromObj #undef TclGetUnicodeFromObj @@ -4181,6 +4180,7 @@ extern const TclStubs *tclStubsPtr; #undef TclSplitPath #undef TclFSSplitPath #undef TclParseArgsObjv +#undef TclGetAliasObj #if TCL_MAJOR_VERSION < 9 /* TIP #627 for 8.7 */ @@ -4226,6 +4226,9 @@ extern const TclStubs *tclStubsPtr; # undef Tcl_ParseArgsObjv # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) \ tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) +# undef Tcl_GetAliasObj +# define Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, objcPtr, objv) \ + tclStubsPtr->tclGetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (objcPtr), (objv)) #elif defined(TCL_8_API) # undef Tcl_GetByteArrayFromObj # undef Tcl_GetBytesFromObj @@ -4238,6 +4241,7 @@ extern const TclStubs *tclStubsPtr; # undef Tcl_SplitPath # undef Tcl_FSSplitPath # undef Tcl_ParseArgsObjv +# undef Tcl_GetAliasObj # if !defined(USE_TCL_STUBS) # define Tcl_GetByteArrayFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetBytesFromObj(NULL, (objPtr), (sizePtr)) : \ @@ -4272,6 +4276,9 @@ extern const TclStubs *tclStubsPtr; # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) <= sizeof(int) ? \ TclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) : \ (Tcl_ParseArgsObjv)((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv))) +# define Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, objcPtr, objv) (sizeof(*(objcPtr)) <= sizeof(int) ? \ + TclGetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (objcPtr), (objv)) : \ + (Tcl_GetAliasObj)((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (Tcl_Size *)(void *)(objcPtr), (objv))) # elif !defined(BUILD_tcl) # define Tcl_GetByteArrayFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetBytesFromObj(NULL, (objPtr), (sizePtr)) : \ @@ -4306,6 +4313,9 @@ extern const TclStubs *tclStubsPtr; # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) <= sizeof(int) ? \ tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) : \ tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv))) +# define Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, objcPtr, objv) (sizeof(*(objcPtr)) <= sizeof(int) ? \ + tclStubsPtr->tclGetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (objcPtr), (objv)) : \ + tclStubsPtr->tcl_GetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (Tcl_Size *)(void *)(objcPtr), (objv))) # endif /* defined(USE_TCL_STUBS) */ #else /* !defined(TCL_8_API) */ # undef Tcl_GetByteArrayFromObj diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 69e3157..b2d883b 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -51,7 +51,7 @@ typedef struct { * used in the parent interpreter to map back * from the target command to aliases * redirecting to it. */ - int objc; /* Count of Tcl_Obj in the prefix of the + Tcl_Size objc; /* Count of Tcl_Obj in the prefix of the * target command to be invoked in the target * interpreter. Additional arguments specified * when calling the alias in the child interp @@ -215,7 +215,7 @@ struct LimitHandler { static int AliasCreate(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Interp *parentInterp, - Tcl_Obj *namePtr, Tcl_Obj *targetPtr, int objc, + Tcl_Obj *namePtr, Tcl_Obj *targetPtr, Tcl_Size objc, Tcl_Obj *const objv[]); static int AliasDelete(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Obj *namePtr); @@ -225,42 +225,42 @@ static int AliasList(Tcl_Interp *interp, Tcl_Interp *childInterp); static Tcl_ObjCmdProc AliasNRCmd; static Tcl_CmdDeleteProc AliasObjCmdDeleteProc; static Tcl_Interp * GetInterp(Tcl_Interp *interp, Tcl_Obj *pathPtr); -static Tcl_Interp * GetInterp2(Tcl_Interp *interp, int objc, +static Tcl_Interp * GetInterp2(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); static Tcl_InterpDeleteProc InterpInfoDeleteProc; static int ChildBgerror(Tcl_Interp *interp, - Tcl_Interp *childInterp, int objc, + Tcl_Interp *childInterp, Tcl_Size objc, Tcl_Obj *const objv[]); static Tcl_Interp * ChildCreate(Tcl_Interp *interp, Tcl_Obj *pathPtr, int safe); static int ChildDebugCmd(Tcl_Interp *interp, Tcl_Interp *childInterp, - int objc, Tcl_Obj *const objv[]); + Tcl_Size objc, Tcl_Obj *const objv[]); static int ChildEval(Tcl_Interp *interp, Tcl_Interp *childInterp, - int objc, Tcl_Obj *const objv[]); + Tcl_Size objc, Tcl_Obj *const objv[]); static int ChildExpose(Tcl_Interp *interp, - Tcl_Interp *childInterp, int objc, + Tcl_Interp *childInterp, Tcl_Size objc, Tcl_Obj *const objv[]); static int ChildHide(Tcl_Interp *interp, Tcl_Interp *childInterp, - int objc, Tcl_Obj *const objv[]); + Tcl_Size objc, Tcl_Obj *const objv[]); static int ChildHidden(Tcl_Interp *interp, Tcl_Interp *childInterp); static int ChildInvokeHidden(Tcl_Interp *interp, Tcl_Interp *childInterp, const char *namespaceName, - int objc, Tcl_Obj *const objv[]); + Tcl_Size objc, Tcl_Obj *const objv[]); static int ChildMarkTrusted(Tcl_Interp *interp, Tcl_Interp *childInterp); static Tcl_CmdDeleteProc ChildObjCmdDeleteProc; static int ChildRecursionLimit(Tcl_Interp *interp, - Tcl_Interp *childInterp, int objc, + Tcl_Interp *childInterp, Tcl_Size objc, Tcl_Obj *const objv[]); static int ChildCommandLimitCmd(Tcl_Interp *interp, - Tcl_Interp *childInterp, int consumedObjc, - int objc, Tcl_Obj *const objv[]); + Tcl_Interp *childInterp, Tcl_Size consumedObjc, + Tcl_Size objc, Tcl_Obj *const objv[]); static int ChildTimeLimitCmd(Tcl_Interp *interp, - Tcl_Interp *childInterp, int consumedObjc, - int objc, Tcl_Obj *const objv[]); + Tcl_Interp *childInterp, Tcl_Size consumedObjc, + Tcl_Size objc, Tcl_Obj *const objv[]); static void InheritLimitsFromParent(Tcl_Interp *childInterp, Tcl_Interp *parentInterp); static void SetScriptLimitCallback(Tcl_Interp *interp, int type, @@ -710,7 +710,8 @@ NRInterpCmd( } return ChildBgerror(interp, childInterp, objc - 3, objv + 3); case OPT_CANCEL: { - int i, flags; + Tcl_Size i; + int flags; Tcl_Obj *resultObjPtr; static const char *const cancelOptions[] = { "-unwind", "--", NULL @@ -782,7 +783,8 @@ NRInterpCmd( return Tcl_CancelEval(childInterp, resultObjPtr, 0, flags); } case OPT_CREATE: { - int i, last, safe; + int last, safe; + Tcl_Size i; Tcl_Obj *childPtr; char buf[16 + TCL_INTEGER_SPACE]; static const char *const createOptions[] = { @@ -833,7 +835,7 @@ NRInterpCmd( for (i = 0; ; i++) { Tcl_CmdInfo cmdInfo; - snprintf(buf, sizeof(buf), "interp%d", i); + snprintf(buf, sizeof(buf), "interp%" TCL_SIZE_MODIFIER "d", i); if (Tcl_GetCommandInfo(interp, buf, &cmdInfo) == 0) { break; } @@ -864,7 +866,7 @@ NRInterpCmd( } return ChildDebugCmd(interp, childInterp, objc - 3, objv + 3); case OPT_DELETE: { - int i; + Tcl_Size i; InterpInfo *iiPtr; for (i = 2; i < objc; i++) { @@ -942,7 +944,7 @@ NRInterpCmd( Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(childInterp))); return TCL_OK; case OPT_INVOKEHID: { - int i; + Tcl_Size i; const char *namespaceName; static const char *const hiddenOptions[] = { "-global", "-namespace", "--", NULL @@ -1163,7 +1165,7 @@ static Tcl_Interp * GetInterp2( Tcl_Interp *interp, /* Default interp if no interp was specified * on the command line. */ - int objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc == 2) { @@ -1276,69 +1278,6 @@ Tcl_CreateAliasObj( /* *---------------------------------------------------------------------- * - * Tcl_GetAlias -- - * - * Gets information about an alias. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ -#ifndef TCL_NO_DEPRECATED -int -Tcl_GetAlias( - Tcl_Interp *interp, /* Interp to start search from. */ - const char *aliasName, /* Name of alias to find. */ - Tcl_Interp **targetInterpPtr, - /* (Return) target interpreter. */ - const char **targetCmdPtr, /* (Return) name of target command. */ - int *argcPtr, /* (Return) count of addnl args. */ - const char ***argvPtr) /* (Return) additional arguments. */ -{ - InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo; - Tcl_HashEntry *hPtr; - Alias *aliasPtr; - int i, objc; - Tcl_Obj **objv; - - hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName); - if (hPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "alias \"%s\" not found", aliasName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, (char *)NULL); - return TCL_ERROR; - } - aliasPtr = (Alias *)Tcl_GetHashValue(hPtr); - objc = aliasPtr->objc; - objv = &aliasPtr->objPtr; - - if (targetInterpPtr != NULL) { - *targetInterpPtr = aliasPtr->targetInterp; - } - if (targetCmdPtr != NULL) { - *targetCmdPtr = TclGetString(objv[0]); - } - if (argcPtr != NULL) { - *argcPtr = objc - 1; - } - if (argvPtr != NULL) { - *argvPtr = (const char **) - Tcl_Alloc(sizeof(const char *) * (objc - 1)); - for (i = 1; i < objc; i++) { - (*argvPtr)[i - 1] = TclGetString(objv[i]); - } - } - return TCL_OK; -} -#endif /* TCL_NO_DEPRECATED */ - -/* - *---------------------------------------------------------------------- - * * Tcl_GetAliasObj -- * * Object version: Gets information about an alias. @@ -1359,13 +1298,13 @@ Tcl_GetAliasObj( Tcl_Interp **targetInterpPtr, /* (Return) target interpreter. */ const char **targetCmdPtr, /* (Return) name of target command. */ - int *objcPtr, /* (Return) count of addnl args. */ + Tcl_Size *objcPtr, /* (Return) count of addnl args. */ Tcl_Obj ***objvPtr) /* (Return) additional args. */ { InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo; Tcl_HashEntry *hPtr; Alias *aliasPtr; - int objc; + Tcl_Size objc; Tcl_Obj **objv; hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName); @@ -1523,7 +1462,7 @@ AliasCreate( * invoked. */ Tcl_Obj *namePtr, /* Name of alias cmd. */ Tcl_Obj *targetCmdPtr, /* Name of target cmd. */ - int objc, /* Additional arguments to store */ + Tcl_Size objc, /* Additional arguments to store */ Tcl_Obj *const objv[]) /* with alias. */ { Alias *aliasPtr; @@ -1532,7 +1471,8 @@ AliasCreate( Child *childPtr; Parent *parentPtr; Tcl_Obj **prefv; - int isNew, i; + int isNew; + Tcl_Size i; aliasPtr = (Alias *)Tcl_Alloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *)); aliasPtr->token = namePtr; @@ -1828,7 +1768,7 @@ AliasNRCmd( Tcl_Obj *const objv[]) /* Argument vector. */ { Alias *aliasPtr = (Alias *)clientData; - int prefc, cmdc, i; + Tcl_Size prefc, cmdc, i; Tcl_Obj **prefv, **cmdv; Tcl_Obj *listPtr; ListRep listRep; @@ -1883,7 +1823,8 @@ TclAliasObjCmd( #define ALIAS_CMDV_PREALLOC 10 Alias *aliasPtr = (Alias *)clientData; Tcl_Interp *targetInterp = aliasPtr->targetInterp; - int result, prefc, cmdc, i; + int result; + Tcl_Size prefc, cmdc, i; Tcl_Obj **prefv, **cmdv; Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC]; Interp *tPtr = (Interp *) targetInterp; @@ -1973,7 +1914,8 @@ TclLocalAliasObjCmd( { #define ALIAS_CMDV_PREALLOC 10 Alias *aliasPtr = (Alias *)clientData; - int result, prefc, cmdc, i; + int result; + Tcl_Size prefc, cmdc, i; Tcl_Obj **prefv, **cmdv; Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC]; Interp *iPtr = (Interp *) interp; @@ -2055,7 +1997,7 @@ AliasObjCmdDeleteProc( { Alias *aliasPtr = (Alias *)clientData; Target *targetPtr; - int i; + Tcl_Size i; Tcl_Obj **objv; Tcl_DecrRefCount(aliasPtr->token); @@ -2379,7 +2321,7 @@ static int ChildBgerror( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which limit is set/queried. */ - int objc, /* Set or Query. */ + Tcl_Size objc, /* Set or Query. */ Tcl_Obj *const objv[]) /* Argument strings. */ { if (objc) { @@ -2665,7 +2607,7 @@ NRChildCmd( Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(childInterp))); return TCL_OK; case OPT_INVOKEHIDDEN: { - int i; + Tcl_Size i; const char *namespaceName; static const char *const hiddenOptions[] = { "-global", "-namespace", "--", NULL @@ -2814,7 +2756,7 @@ ChildDebugCmd( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* The child interpreter in which command * will be evaluated. */ - int objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const debugTypes[] = { @@ -2885,7 +2827,7 @@ ChildEval( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* The child interpreter in which command * will be evaluated. */ - int objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; @@ -2948,7 +2890,7 @@ static int ChildExpose( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which command will be exposed. */ - int objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { const char *name; @@ -2992,7 +2934,7 @@ static int ChildRecursionLimit( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which limit is set/queried. */ - int objc, /* Set or Query. */ + Tcl_Size objc, /* Set or Query. */ Tcl_Obj *const objv[]) /* Argument strings. */ { Interp *iPtr; @@ -3054,7 +2996,7 @@ static int ChildHide( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which command will be exposed. */ - int objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { const char *name; @@ -3139,7 +3081,7 @@ ChildInvokeHidden( Tcl_Interp *childInterp, /* The child interpreter in which command will * be invoked. */ const char *namespaceName, /* The namespace to use, if any. */ - int objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; @@ -4482,8 +4424,8 @@ static int ChildCommandLimitCmd( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Interp *childInterp, /* Interpreter being adjusted. */ - int consumedObjc, /* Number of args already parsed. */ - int objc, /* Total number of arguments. */ + Tcl_Size consumedObjc, /* Number of args already parsed. */ + Tcl_Size objc, /* Total number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const options[] = { @@ -4583,8 +4525,7 @@ ChildCommandLimitCmd( Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); return TCL_ERROR; } else { - int i; - Tcl_Size scriptLen = 0, limitLen = 0; + Tcl_Size i, scriptLen = 0, limitLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL, *limitObj = NULL; int gran = 0, limit = 0; @@ -4670,8 +4611,8 @@ static int ChildTimeLimitCmd( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Interp *childInterp, /* Interpreter being adjusted. */ - int consumedObjc, /* Number of args already parsed. */ - int objc, /* Total number of arguments. */ + Tcl_Size consumedObjc, /* Number of args already parsed. */ + Tcl_Size objc, /* Total number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const options[] = { @@ -4788,8 +4729,7 @@ ChildTimeLimitCmd( Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); return TCL_ERROR; } else { - int i; - Tcl_Size scriptLen = 0, milliLen = 0, secLen = 0; + Tcl_Size i, scriptLen = 0, milliLen = 0, secLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL; Tcl_Obj *milliObj = NULL, *secObj = NULL; int gran = 0; diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 3504bf7..90501ff 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -74,7 +74,6 @@ # define TclGetStringFromObj 0 # define TclGetBytesFromObj 0 # define TclGetUnicodeFromObj 0 -# define Tcl_GetAlias 0 #endif #undef Tcl_Close #define Tcl_Close 0 @@ -95,6 +94,7 @@ # define TclSplitPath 0 # define TclFSSplitPath 0 # define TclParseArgsObjv 0 +# define TclGetAliasObj 0 #else /* !defined(TCL_NO_DEPRECATED) */ int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, void *objcPtr, Tcl_Obj ***objvPtr) { @@ -189,6 +189,22 @@ int TclParseArgsObjv(Tcl_Interp *interp, *(int *)objcPtr = (int)n; return result; } +int TclGetAliasObj(Tcl_Interp *interp, const char *childCmd, + Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, + int *objcPtr, Tcl_Obj ***objv) { + Tcl_Size n = TCL_INDEX_NONE; + int result = Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, &n, objv); + if (objcPtr) { + if ((sizeof(int) != sizeof(Tcl_Size)) && (result == TCL_OK) && (n > INT_MAX)) { + if (interp) { + Tcl_AppendResult(interp, "List too large to be processed", NULL); + } + return TCL_ERROR; + } + *objcPtr = (int)n; + } + return result; +} #endif /* !defined(TCL_NO_DEPRECATED) */ #define TclBN_mp_add mp_add @@ -951,8 +967,8 @@ const TclStubs tclStubs = { Tcl_FirstHashEntry, /* 145 */ Tcl_Flush, /* 146 */ 0, /* 147 */ - Tcl_GetAlias, /* 148 */ - Tcl_GetAliasObj, /* 149 */ + 0, /* 148 */ + TclGetAliasObj, /* 149 */ Tcl_GetAssocData, /* 150 */ Tcl_GetChannel, /* 151 */ Tcl_GetChannelBufferSize, /* 152 */ @@ -1088,7 +1104,7 @@ const TclStubs tclStubs = { Tcl_UnstackChannel, /* 282 */ Tcl_GetStackedChannel, /* 283 */ Tcl_SetMainLoop, /* 284 */ - 0, /* 285 */ + Tcl_GetAliasObj, /* 285 */ Tcl_AppendObjToObj, /* 286 */ Tcl_CreateEncoding, /* 287 */ Tcl_CreateThreadExitHandler, /* 288 */ |