summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/CrtAlias.328
-rw-r--r--generic/tcl.decls10
-rw-r--r--generic/tclDecls.h41
-rw-r--r--generic/tclInterp.c66
-rw-r--r--generic/tclStubInit.c23
5 files changed, 62 insertions, 106 deletions
diff --git a/doc/CrtAlias.3 b/doc/CrtAlias.3
index fba6253..39a13d6 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
@@ -168,17 +161,14 @@ restrictions on how they are related.
that it takes a vector of values to pass as additional arguments instead
of a vector of strings.
.PP
-\fBTcl_GetAlias\fR returns information about an alias \fIaliasName\fR
+\fBTcl_GetAliasObj\fR returns information in the form of a pointer to a vector
+of Tcl_Obj structures about an alias \fIaliasName\fR
in \fIinterp\fR. Any of the result fields can be \fBNULL\fR, in
which case the corresponding datum is not returned. If a result field is
non\-\fBNULL\fR, the address indicated is set to the corresponding datum.
-For example, if \fItargetNamePtr\fR is non\-\fBNULL\fR it is set to a
+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_GetAliasObj\fR is similar to \fBTcl_GetAlias\fR except that it
-returns a pointer to a vector of Tcl_Obj structures instead of a vector of
-strings.
-.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 5f82a1c..2bc1934 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -470,15 +470,15 @@ declare 145 {
declare 146 {
int Tcl_Flush(Tcl_Channel chan)
}
-declare 148 {
- int Tcl_GetAlias(Tcl_Interp *interp, const char *childCmd,
+declare 147 {
+ int Tcl_GetAliasObj(Tcl_Interp *interp, const char *childCmd,
Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
- int *argcPtr, const char ***argvPtr)
+ Tcl_Size *objcPtr, Tcl_Obj ***objvPtr)
}
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,
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 0d5bfe5..c867549 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -426,19 +426,19 @@ EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
Tcl_HashSearch *searchPtr);
/* 146 */
EXTERN int Tcl_Flush(Tcl_Channel chan);
-/* Slot 147 is reserved */
-/* 148 */
-EXTERN int Tcl_GetAlias(Tcl_Interp *interp,
+/* 147 */
+EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp,
const char *childCmd,
Tcl_Interp **targetInterpPtr,
- const char **targetCmdPtr, int *argcPtr,
- const char ***argvPtr);
+ const char **targetCmdPtr, Tcl_Size *objcPtr,
+ Tcl_Obj ***objvPtr);
+/* 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,
@@ -2026,9 +2026,9 @@ typedef struct TclStubs {
void (*reserved144)(void);
Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
- void (*reserved147)(void);
- 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 */
+ int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr); /* 147 */
+ 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 */
@@ -2859,11 +2859,11 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_FirstHashEntry) /* 145 */
#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 */
+ (tclStubsPtr->tcl_GetAliasObj) /* 147 */
+/* Slot 148 is reserved */
+#define TclGetAliasObj \
+ (tclStubsPtr->tclGetAliasObj) /* 149 */
#define Tcl_GetAssocData \
(tclStubsPtr->tcl_GetAssocData) /* 150 */
#define Tcl_GetChannel \
@@ -4158,7 +4158,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
@@ -4169,6 +4169,7 @@ extern const TclStubs *tclStubsPtr;
#undef TclSplitPath
#undef TclFSSplitPath
#undef TclParseArgsObjv
+#undef TclGetAliasObj
#if TCL_MAJOR_VERSION < 9
/* TIP #627 for 8.7 */
@@ -4214,6 +4215,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
@@ -4226,6 +4230,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)) : \
@@ -4260,6 +4265,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)) : \
@@ -4294,6 +4302,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 5127936..3579e9b 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -1276,68 +1276,6 @@ Tcl_CreateAliasObj(
/*
*----------------------------------------------------------------------
*
- * Tcl_GetAlias --
- *
- * Gets information about an alias.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-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 **targetNamePtr, /* (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 (targetNamePtr != NULL) {
- *targetNamePtr = 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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_GetAliasObj --
*
* Object version: Gets information about an alias.
@@ -1358,13 +1296,13 @@ Tcl_GetAliasObj(
Tcl_Interp **targetInterpPtr,
/* (Return) target interpreter. */
const char **targetNamePtr, /* (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);
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 92e9b1c..1d8dd7a 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -94,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) {
@@ -188,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(size_t)) && (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
@@ -949,9 +966,9 @@ const TclStubs tclStubs = {
0, /* 144 */
Tcl_FirstHashEntry, /* 145 */
Tcl_Flush, /* 146 */
- 0, /* 147 */
- Tcl_GetAlias, /* 148 */
- Tcl_GetAliasObj, /* 149 */
+ Tcl_GetAliasObj, /* 147 */
+ 0, /* 148 */
+ TclGetAliasObj, /* 149 */
Tcl_GetAssocData, /* 150 */
Tcl_GetChannel, /* 151 */
Tcl_GetChannelBufferSize, /* 152 */
generated by cgit v0.12 at 2025-12-25 16:59:17 (GMT)