Add Tcl_GetAlias/Tcl_GetAliasObj to TIP #616

5 files changed, 114 insertions, 29 deletions

diff --git a/doc/CrtAlias.3 b/doc/CrtAlias.3
index fba6253..879e07c 100644
--- a/doc/CrtAlias.3
+++ b/doc/CrtAlias.3
@@ -87,16 +87,24 @@ 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
+.AP "Tcl_Size \&| 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.
+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 "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
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 5f82a1c..bdc581c 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -463,6 +463,11 @@ declare 142 {
 declare 143 {
     void Tcl_Finalize(void)
 }
+declare 144 {
+    int Tcl_GetAlias(Tcl_Interp *interp, const char *childCmd,
+	    Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
+	    Tcl_Size *argcPtr, const char ***argvPtr)
+}
 declare 145 {
     Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
 	    Tcl_HashSearch *searchPtr)
@@ -470,15 +475,20 @@ declare 145 {
 declare 146 {
     int Tcl_Flush(Tcl_Channel chan)
 }
+declare 147 {
+    int Tcl_GetAliasObj(Tcl_Interp *interp, const char *childCmd,
+	    Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
+	    Tcl_Size *objcPtr, Tcl_Obj ***objvPtr)
+}
 declare 148 {
-    int Tcl_GetAlias(Tcl_Interp *interp, const char *childCmd,
+    int TclGetAlias(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,
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index a2b0ec1..307699b 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -420,25 +420,34 @@ EXTERN int		Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 EXTERN int		Tcl_ExprString(Tcl_Interp *interp, const char *expr);
 /* 143 */
 EXTERN void		Tcl_Finalize(void);
-/* Slot 144 is reserved */
+/* 144 */
+EXTERN int		Tcl_GetAlias(Tcl_Interp *interp,
+				const char *childCmd,
+				Tcl_Interp **targetInterpPtr,
+				const char **targetCmdPtr, Tcl_Size *argcPtr,
+				const char ***argvPtr);
 /* 145 */
 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, Tcl_Size *objcPtr,
+				Tcl_Obj ***objvPtr);
+/* 148 */
+EXTERN int		TclGetAlias(Tcl_Interp *interp, const char *childCmd,
+				Tcl_Interp **targetInterpPtr,
 				const char **targetCmdPtr, int *argcPtr,
 				const char ***argvPtr);
 /* 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,
@@ -2023,12 +2032,12 @@ typedef struct TclStubs {
     int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */
     int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */
     void (*tcl_Finalize) (void); /* 143 */
-    void (*reserved144)(void);
+    int (*tcl_GetAlias) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, Tcl_Size *argcPtr, const char ***argvPtr); /* 144 */
     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 */
+    int (*tclGetAlias) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */
+    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 */
@@ -2854,16 +2863,18 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_ExprString) /* 142 */
 #define Tcl_Finalize \
 	(tclStubsPtr->tcl_Finalize) /* 143 */
-/* Slot 144 is reserved */
+#define Tcl_GetAlias \
+	(tclStubsPtr->tcl_GetAlias) /* 144 */
 #define Tcl_FirstHashEntry \
 	(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 */
+#define TclGetAlias \
+	(tclStubsPtr->tclGetAlias) /* 148 */
+#define TclGetAliasObj \
+	(tclStubsPtr->tclGetAliasObj) /* 149 */
 #define Tcl_GetAssocData \
 	(tclStubsPtr->tcl_GetAssocData) /* 150 */
 #define Tcl_GetChannel \
@@ -4159,7 +4170,7 @@ extern const TclStubs *tclStubsPtr;
 #endif
 
 #ifdef USE_TCL_STUBS
-    /* Protect those 10 functions, make them useless through the stub table */
+    /* Protect those 12 functions, make them useless through the stub table */
 #   undef TclGetStringFromObj
 #   undef TclGetBytesFromObj
 #   undef TclGetUnicodeFromObj
@@ -4170,6 +4181,8 @@ extern const TclStubs *tclStubsPtr;
 #   undef TclSplitPath
 #   undef TclFSSplitPath
 #   undef TclParseArgsObjv
+#   undef TclGetAlias
+#   undef TclGetAliasObj
 #endif
 
 #if TCL_MAJOR_VERSION < 9
@@ -4216,6 +4229,12 @@ extern const TclStubs *tclStubsPtr;
 #   undef Tcl_ParseArgsObjv
 #   define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) \
 	    tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv))
+#   undef Tcl_GetAlias
+#   define Tcl_GetAlias(interp, childCmd, targetInterpPtr, targetCmdPtr, argcPtr, argvPtr) \
+	    tclStubsPtr->tclGetAlias((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (argcPtr), (argvPtr))
+#   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
@@ -4228,6 +4247,8 @@ extern const TclStubs *tclStubsPtr;
 #   undef Tcl_SplitPath
 #   undef Tcl_FSSplitPath
 #   undef Tcl_ParseArgsObjv
+#   undef Tcl_GetAlias
+#   undef Tcl_GetAliasObj
 #   if !defined(USE_TCL_STUBS)
 #	define Tcl_GetByteArrayFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \
 		TclGetBytesFromObj(NULL, (objPtr), (sizePtr)) : \
@@ -4262,6 +4283,12 @@ 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_GetAlias(interp, childCmd, targetInterpPtr, targetCmdPtr, argcPtr, argvPtr) (sizeof(*(argcPtr)) <= sizeof(int) ? \
+		TclGetAlias((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (argcPtr), (argvPtr)) : \
+		(Tcl_GetAlias)((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
+#	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)) : \
@@ -4296,6 +4323,12 @@ 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_GetAlias(interp, childCmd, targetInterpPtr, targetCmdPtr, argcPtr, argvPtr) (sizeof(*(argcPtr)) <= sizeof(int) ? \
+		tclStubsPtr->tclGetAlias((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (argcPtr), (argvPtr)) : \
+		tclStubsPtr->tcl_GetAlias((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
+#	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 fa6cf80..5d949cf 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -1296,13 +1296,13 @@ Tcl_GetAlias(
     Tcl_Interp **targetInterpPtr,
 				/* (Return) target interpreter. */
     const char **targetNamePtr,	/* (Return) name of target command. */
-    int *argcPtr,		/* (Return) count of addnl args. */
+    Tcl_Size *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_Size i, objc;
     Tcl_Obj **objv;
 
     hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName);
@@ -1358,13 +1358,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 9072796..58b0465 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -98,6 +98,8 @@
 # define TclSplitPath 0
 # define TclFSSplitPath 0
 # define TclParseArgsObjv 0
+# define TclGetAlias 0
+# define TclGetAliasObj 0
 #else /* !defined(TCL_NO_DEPRECATED) */
 int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
     void *objcPtr, Tcl_Obj ***objvPtr) {
@@ -192,6 +194,38 @@ int TclParseArgsObjv(Tcl_Interp *interp,
     *(int *)objcPtr = (int)n;
     return result;
 }
+int TclGetAlias(Tcl_Interp *interp, const char *childCmd,
+	Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
+	int *argcPtr, const char ***argvPtr) {
+    Tcl_Size n = TCL_INDEX_NONE;
+    int result = Tcl_GetAlias(interp, childCmd, targetInterpPtr, targetCmdPtr, &n, argvPtr);
+    if (argcPtr) {
+	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;
+	}
+	*argcPtr = (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
@@ -939,12 +973,12 @@ const TclStubs tclStubs = {
     Tcl_ExprObj, /* 141 */
     Tcl_ExprString, /* 142 */
     Tcl_Finalize, /* 143 */
-    0, /* 144 */
+    Tcl_GetAlias, /* 144 */
     Tcl_FirstHashEntry, /* 145 */
     Tcl_Flush, /* 146 */
-    0, /* 147 */
-    Tcl_GetAlias, /* 148 */
-    Tcl_GetAliasObj, /* 149 */
+    Tcl_GetAliasObj, /* 147 */
+    TclGetAlias, /* 148 */
+    TclGetAliasObj, /* 149 */
     Tcl_GetAssocData, /* 150 */
     Tcl_GetChannel, /* 151 */
     Tcl_GetChannelBufferSize, /* 152 */