Add TclParseArgsObjv_

8 files changed, 110 insertions, 39 deletions

diff --git a/doc/ParseArgs.3 b/doc/ParseArgs.3
index 02b52d4..ec5a29e 100644
--- a/doc/ParseArgs.3
+++ b/doc/ParseArgs.3
@@ -142,16 +142,16 @@ there are no following arguments at all, and the \fIdstPtr\fR argument to the
 \fBTCL_ARGV_GENFUNC\fR
 .
 This argument takes zero or more following arguments; the handler callback
-function passed in \fIsrcPtr\fR returns how many (or a negative number to
+function passed in \fIsrcPtr\fR returns how many (or TCL_INDEX_NONE to
 signal an error, in which case it should also set the interpreter result). The
 function will have the following signature:
 .RS
 .PP
 .CS
-typedef int (\fBTcl_ArgvGenFuncProc\fR)(
+typedef size_t (\fBTcl_ArgvGenFuncProc\fR)(
         void *\fIclientData\fR,
         Tcl_Interp *\fIinterp\fR,
-        int \fIobjc\fR,
+        size_t \fIobjc\fR,
         Tcl_Obj *const *\fIobjv\fR,
         void *\fIdstPtr\fR);
 .CE
diff --git a/doc/SplitList.3 b/doc/SplitList.3
index 49498e2..696906c 100644
--- a/doc/SplitList.3
+++ b/doc/SplitList.3
@@ -81,7 +81,8 @@ For example, suppose that you have called \fBTcl_SplitList\fR with
 the following code:
 .PP
 .CS
-int argc, code;
+size_t argc;
+int code;
 char *string;
 char **argv;
 \&...
@@ -92,7 +93,7 @@ Then you should eventually free the storage with a call like the
 following:
 .PP
 .CS
-Tcl_Free((char *) argv);
+Tcl_Free(argv);
 .CE
 .PP
 \fBTcl_SplitList\fR normally returns \fBTCL_OK\fR, which means the list was
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 676373b..ebbc850 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2269,7 +2269,7 @@ declare 603 {
 
 # TIP#265 (option parser) dkf for Sam Bromley
 declare 604 {
-    int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable,
+    int TclParseArgsObjv_(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable,
 	    int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv)
 }
 
@@ -2527,6 +2527,10 @@ declare 665 {
 declare 666 {
     Tcl_Obj *Tcl_FSSplitPath(Tcl_Obj *pathPtr, size_t *lenPtr)
 }
+declare 667 {
+    int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable,
+	    size_t *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv)
+}
 
 # ----- BASELINE -- FOR -- 8.7.0 ----- #
 
diff --git a/generic/tcl.h b/generic/tcl.h
index c3db670..0858f2e 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2040,8 +2040,8 @@ typedef struct {
 
 typedef int (Tcl_ArgvFuncProc)(void *clientData, Tcl_Obj *objPtr,
 	void *dstPtr);
-typedef int (Tcl_ArgvGenFuncProc)(void *clientData, Tcl_Interp *interp,
-	int objc, Tcl_Obj *const *objv, void *dstPtr);
+typedef size_t (Tcl_ArgvGenFuncProc)(void *clientData, Tcl_Interp *interp,
+	size_t objc, Tcl_Obj *const *objv, void *dstPtr);
 
 /*
  * Shorthand for commonly used argTable entries.
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index b1c3d10..1a792a8 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1598,7 +1598,7 @@ EXTERN int		Tcl_SetEnsembleParameterList(Tcl_Interp *interp,
 EXTERN int		Tcl_GetEnsembleParameterList(Tcl_Interp *interp,
 				Tcl_Command token, Tcl_Obj **paramListPtr);
 /* 604 */
-EXTERN int		Tcl_ParseArgsObjv(Tcl_Interp *interp,
+EXTERN int		TclParseArgsObjv_(Tcl_Interp *interp,
 				const Tcl_ArgvInfo *argTable, int *objcPtr,
 				Tcl_Obj *const *objv, Tcl_Obj ***remObjv);
 /* 605 */
@@ -1776,6 +1776,11 @@ EXTERN void		Tcl_SplitPath(const char *path, size_t *argcPtr,
 				const char ***argvPtr);
 /* 666 */
 EXTERN Tcl_Obj *	Tcl_FSSplitPath(Tcl_Obj *pathPtr, size_t *lenPtr);
+/* 667 */
+EXTERN int		Tcl_ParseArgsObjv(Tcl_Interp *interp,
+				const Tcl_ArgvInfo *argTable,
+				size_t *objcPtr, Tcl_Obj *const *objv,
+				Tcl_Obj ***remObjv);
 
 typedef struct {
     const struct TclPlatStubs *tclPlatStubs;
@@ -2391,7 +2396,7 @@ typedef struct TclStubs {
     unsigned (*tcl_GetBlockSizeFromStat) (const Tcl_StatBuf *statPtr); /* 601 */
     int (*tcl_SetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList); /* 602 */
     int (*tcl_GetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 603 */
-    int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */
+    int (*tclParseArgsObjv_) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */
     int (*tcl_GetErrorLine) (Tcl_Interp *interp); /* 605 */
     void (*tcl_SetErrorLine) (Tcl_Interp *interp, int lineNum); /* 606 */
     void (*tcl_TransferResult) (Tcl_Interp *sourceInterp, int code, Tcl_Interp *targetInterp); /* 607 */
@@ -2454,6 +2459,7 @@ typedef struct TclStubs {
     int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, size_t *argcPtr, const char ***argvPtr); /* 664 */
     void (*tcl_SplitPath) (const char *path, size_t *argcPtr, const char ***argvPtr); /* 665 */
     Tcl_Obj * (*tcl_FSSplitPath) (Tcl_Obj *pathPtr, size_t *lenPtr); /* 666 */
+    int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, size_t *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 667 */
 } TclStubs;
 
 extern const TclStubs *tclStubsPtr;
@@ -3612,8 +3618,8 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_SetEnsembleParameterList) /* 602 */
 #define Tcl_GetEnsembleParameterList \
 	(tclStubsPtr->tcl_GetEnsembleParameterList) /* 603 */
-#define Tcl_ParseArgsObjv \
-	(tclStubsPtr->tcl_ParseArgsObjv) /* 604 */
+#define TclParseArgsObjv_ \
+	(tclStubsPtr->tclParseArgsObjv_) /* 604 */
 #define Tcl_GetErrorLine \
 	(tclStubsPtr->tcl_GetErrorLine) /* 605 */
 #define Tcl_SetErrorLine \
@@ -3736,6 +3742,8 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_SplitPath) /* 665 */
 #define Tcl_FSSplitPath \
 	(tclStubsPtr->tcl_FSSplitPath) /* 666 */
+#define Tcl_ParseArgsObjv \
+	(tclStubsPtr->tcl_ParseArgsObjv) /* 667 */
 
 #endif /* defined(USE_TCL_STUBS) */
 
@@ -3935,28 +3943,32 @@ extern const TclStubs *tclStubsPtr;
 #if 0
 #   undef Tcl_ListObjGetElements
 #   define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*objcPtr) != sizeof(int) \
-		? tclStubsPtr->tcl_ListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \
-		: tclStubsPtr->tclListObjGetElements_((interp), (listPtr), (size_t *)(void *)(objcPtr), (objvPtr)))
+		? tclStubsPtr->tcl_ListObjGetElements((interp), (listPtr), (size_t *)(void *)(objcPtr), (objvPtr)) \
+		: tclStubsPtr->tclListObjGetElements_((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)))
 #   undef Tcl_ListObjLength
 #   define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*lengthPtr) != sizeof(int) \
-		? tclStubsPtr->tcl_ListObjLength((interp), (listPtr), (int *)(void *)(lengthPtr)) \
-		: tclStubsPtr->tclListObjLength_((interp), (listPtr), (size_t *)(void *)(lengthPtr)))
+		? tclStubsPtr->tcl_ListObjLength((interp), (listPtr), (size_t *)(void *)(lengthPtr)) \
+		: tclStubsPtr->tclListObjLength_((interp), (listPtr), (int *)(void *)(lengthPtr)))
 #   undef Tcl_DictObjSize
 #   define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*sizePtr) != sizeof(int) \
-		? tclStubsPtr->tcl_DictObjSize((interp), (dictPtr), (int *)(void *)(sizePtr)) \
-		: tclStubsPtr->tclDictObjSize_((interp), (dictPtr), (size_t *)(void *)(sizePtr)))
+		? tclStubsPtr->tcl_DictObjSize((interp), (dictPtr), (size_t *)(void *)(sizePtr)) \
+		: tclStubsPtr->tclDictObjSize_((interp), (dictPtr), (int *)(void *)(sizePtr)))
 #   undef Tcl_SplitList
 #   define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*argcPtr) != sizeof(int) \
-		? tclStubsPtr->tcl_SplitList((interp), (listStr), (int *)(void *)(argcPtr), (argvPtr)) \
-		: tclStubsPtr->tclSplitList_((interp), (listStr), (size_t *)(void *)(argcPtr), (argvPtr)))
+		? tclStubsPtr->tcl_SplitList((interp), (listStr), (size_t *)(void *)(argcPtr), (argvPtr)) \
+		: tclStubsPtr->tclSplitList_((interp), (listStr), (int *)(void *)(argcPtr), (argvPtr)))
 #   undef Tcl_SplitPath
 #   define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*argcPtr) != sizeof(int) \
-		? tclStubsPtr->tcl_SplitPath((path), (int *)(void *)(argcPtr), (argvPtr)) \
-		: tclStubsPtr->tclSplitPath_((path), (size_t *)(void *)(argcPtr), (argvPtr)))
+		? tclStubsPtr->tcl_SplitPath((path), (size_t *)(void *)(argcPtr), (argvPtr)) \
+		: tclStubsPtr->tclSplitPath_((path), (int *)(void *)(argcPtr), (argvPtr)))
 #   undef Tcl_FSSplitPath
 #   define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*lenPtr) != sizeof(int) \
-		? tclStubsPtr->tcl_FSSplitPath((pathPtr), (int *)(void *)(lenPtr)) \
-		: tclStubsPtr->tclFSSplitPath_((pathPtr), (size_t *)(void *)(lenPtr)))
+		? tclStubsPtr->tcl_FSSplitPath((pathPtr), (size_t *)(void *)(lenPtr)) \
+		: tclStubsPtr->tclFSSplitPath_((pathPtr), (int *)(void *)(lenPtr)))
+#   undef Tcl_ParseArgsObjv
+#   define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*objcPtr) != sizeof(int) \
+		? tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (size_t *)(void *)(objcPtr), (objv), (remObjv)) \
+		: tclStubsPtr->tclParseArgsObjv_((interp), (argTable), (int *)(void *)(objcPtr), (objv), (remObjv)))
 #endif /* TCL_NO_DEPRECATED */
 #else
 #   define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 35d3977..cef774b 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -961,7 +961,7 @@ Tcl_ParseArgsObjv(
     Tcl_Interp *interp,		/* Place to store error message. */
     const Tcl_ArgvInfo *argTable,
 				/* Array of option descriptions. */
-    int *objcPtr,		/* Number of arguments in objv. Modified to
+    size_t *objcPtr,		/* Number of arguments in objv. Modified to
 				 * hold # args left in objv at end. */
     Tcl_Obj *const *objv,	/* Array of arguments to be parsed. */
     Tcl_Obj ***remObjv)		/* Pointer to array of arguments that were not
@@ -971,7 +971,7 @@ Tcl_ParseArgsObjv(
     Tcl_Obj **leftovers;	/* Array to write back to remObjv on
 				 * successful exit. Will include the name of
 				 * the command. */
-    int nrem;			/* Size of leftovers.*/
+    size_t nrem;			/* Size of leftovers.*/
     const Tcl_ArgvInfo *infoPtr;
 				/* Pointer to the current entry in the table
 				 * of argument descriptions. */
@@ -983,12 +983,12 @@ Tcl_ParseArgsObjv(
 				 * quick check for matching; use 2nd char.
 				 * because first char. will almost always be
 				 * '-'). */
-    int srcIndex;		/* Location from which to read next argument
+    size_t srcIndex;		/* Location from which to read next argument
 				 * from objv. */
-    int dstIndex;		/* Used to keep track of current arguments
+    size_t dstIndex;		/* Used to keep track of current arguments
 				 * being processed, primarily for error
 				 * reporting. */
-    int objc;			/* # arguments in objv still to process. */
+    size_t objc;			/* # arguments in objv still to process. */
     size_t length;			/* Number of characters in current argument */
 
     if (remObjv != NULL) {
@@ -1147,7 +1147,7 @@ Tcl_ParseArgsObjv(
 
 	    objc = handlerProc(infoPtr->clientData, interp, objc,
 		    &objv[srcIndex], infoPtr->dstPtr);
-	    if (objc < 0) {
+	    if ((int)objc < 0) {
 		goto error;
 	    }
 	    break;
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 1b1ad89..e080d44 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -92,57 +92,110 @@ static void uniCodePanic() {
 #define TclSplitList_ SplitList
 #define TclSplitPath_ SplitPath
 #define TclFSSplitPath_ FSSplitPath
+#define TclParseArgsObjv_ ParseArgsObjv
 int LOGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
     int *objcPtr, Tcl_Obj ***objvPtr) {
-    size_t n;
+    size_t n = TCL_INDEX_NONE;
     int result = Tcl_ListObjGetElements(interp, listPtr, &n, objvPtr);
     if (objcPtr) {
+	if ((result == TCL_OK) && (n > INT_MAX)) {
+	    if (interp) {
+		Tcl_AppendResult(interp, "List too large to be processed", NULL);
+	    }
+	    return TCL_ERROR;
+	}
 	*objcPtr = n;
     }
     return result;
 }
 int LOLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
     int *lengthPtr) {
-    size_t n;
+    size_t n = TCL_INDEX_NONE;
     int result = Tcl_ListObjLength(interp, listPtr, &n);
     if (lengthPtr) {
+	if ((result == TCL_OK) && (n > INT_MAX)) {
+	    if (interp) {
+		Tcl_AppendResult(interp, "List too large to be processed", NULL);
+	    }
+	    return TCL_ERROR;
+	}
 	*lengthPtr = n;
     }
     return result;
 }
 static int DOSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
     int *sizePtr) {
-    size_t n;
+    size_t n = TCL_INDEX_NONE;
     int result = Tcl_DictObjSize(interp, dictPtr, &n);
     if (sizePtr) {
+	if ((result == TCL_OK) && (n > INT_MAX)) {
+	    if (interp) {
+		Tcl_AppendResult(interp, "Dict too large to be processed", NULL);
+	    }
+	    return TCL_ERROR;
+	}
 	*sizePtr = n;
     }
     return result;
 }
 static int SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr,
 	const char ***argvPtr) {
-    size_t n;
+    size_t n = TCL_INDEX_NONE;
     int result = Tcl_SplitList(interp, listStr, &n, argvPtr);
     if (argcPtr) {
+	if ((result == TCL_OK) && (n > INT_MAX)) {
+	    if (interp) {
+		Tcl_AppendResult(interp, "List too large to be processed", NULL);
+	    }
+	    Tcl_Free(*argvPtr);
+	    return TCL_ERROR;
+	}
 	*argcPtr = n;
     }
     return result;
 }
 static void SplitPath(const char *path, int *argcPtr, const char ***argvPtr) {
-    size_t n;
+    size_t n = TCL_INDEX_NONE;
     Tcl_SplitPath(path, &n, argvPtr);
     if (argcPtr) {
+	if (n > INT_MAX) {
+	    n = TCL_INDEX_NONE; /* No other way to return an error-situation */
+	    Tcl_Free(*argvPtr);
+	    *argvPtr = NULL;
+	}
 	*argcPtr = n;
     }
 }
 static Tcl_Obj *FSSplitPath(Tcl_Obj *pathPtr, int *lenPtr) {
-    size_t n;
+    size_t n = TCL_INDEX_NONE;
     Tcl_Obj *result = Tcl_FSSplitPath(pathPtr, &n);
     if (lenPtr) {
+	if (result && (n > INT_MAX)) {
+	    Tcl_DecrRefCount(result);
+	    return NULL;
+	}
 	*lenPtr = n;
     }
     return result;
 }
+static int ParseArgsObjv(Tcl_Interp *interp,
+	const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv,
+	Tcl_Obj ***remObjv) {
+    size_t n = TCL_INDEX_NONE;
+    int result = Tcl_ParseArgsObjv(interp, argTable, &n, objv, remObjv);
+    if (objcPtr) {
+	if ((result == TCL_OK) && (n > INT_MAX)) {
+	    if (interp) {
+		Tcl_AppendResult(interp, "Too many args to be processed", NULL);
+	    }
+	    Tcl_Free(*remObjv);
+	    *remObjv = NULL;
+	    return TCL_ERROR;
+	}
+	*objcPtr = n;
+    }
+    return result;
+}
 
 #define TclBN_mp_add mp_add
 #define TclBN_mp_add_d mp_add_d
@@ -1352,7 +1405,7 @@ const TclStubs tclStubs = {
     Tcl_GetBlockSizeFromStat, /* 601 */
     Tcl_SetEnsembleParameterList, /* 602 */
     Tcl_GetEnsembleParameterList, /* 603 */
-    Tcl_ParseArgsObjv, /* 604 */
+    TclParseArgsObjv_, /* 604 */
     Tcl_GetErrorLine, /* 605 */
     Tcl_SetErrorLine, /* 606 */
     Tcl_TransferResult, /* 607 */
@@ -1415,6 +1468,7 @@ const TclStubs tclStubs = {
     Tcl_SplitList, /* 664 */
     Tcl_SplitPath, /* 665 */
     Tcl_FSSplitPath, /* 666 */
+    Tcl_ParseArgsObjv, /* 667 */
 };
 
 /* !END!: Do not edit above this line. */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index fc14e1d..7a066fd 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -7714,7 +7714,7 @@ TestparseargsCmd(
     Tcl_Obj *const objv[])	/* Arguments. */
 {
     static int foo = 0;
-    int count = objc;
+    size_t count = objc;
     Tcl_Obj **remObjv, *result[3];
     Tcl_ArgvInfo argTable[] = {
         {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL},
@@ -7726,7 +7726,7 @@ TestparseargsCmd(
         return TCL_ERROR;
     }
     result[0] = Tcl_NewIntObj(foo);
-    result[1] = Tcl_NewIntObj(count);
+    result[1] = Tcl_NewWideIntObj((Tcl_WideUInt)(count + 1) - 1);
     result[2] = Tcl_NewListObj(count, remObjv);
     Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
     Tcl_Free(remObjv);