* generic/tclIndexObj.c (Tcl_ParseArgsObjv): [Bug 3413857]: Corrected

	the memory management for the code parsing arguments when returning
	"large" numbers of arguments. Also unbroke the TCL_ARGV_AUTO_REST
	macro in passing.

4 files changed, 106 insertions, 31 deletions

diff --git a/ChangeLog b/ChangeLog
index 9673852..ebf1962 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2011-09-27  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclIndexObj.c (Tcl_ParseArgsObjv): [Bug 3413857]: Corrected
+	the memory management for the code parsing arguments when returning
+	"large" numbers of arguments. Also unbroke the TCL_ARGV_AUTO_REST
+	macro in passing.
+
 2011-09-26  Donal K. Fellows  <dkf@users.sf.net>
 
 	* generic/tclCmdAH.c (TclMakeFileCommandSafe): [Bug 3211758]: Also
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 6f378a4..8651542 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -1113,13 +1113,15 @@ Tcl_ParseArgsObjv(
 
     if (remObjv != NULL) {
 	/*
-	 * Then we should copy the name of the command (0th argument).
+	 * Then we should copy the name of the command (0th argument). The
+	 * upper bound on the number of elements is known, and (undocumented,
+	 * but historically true) there should be a NULL argument after the
+	 * last result. [Bug 3413857]
 	 */
 
 	nrem = 1;
-	leftovers = ckalloc((nrem + 1) * sizeof(Tcl_Obj *));
-	leftovers[nrem-1] = objv[0];
-	leftovers[nrem] = NULL;
+	leftovers = ckalloc((1 + *objcPtr) * sizeof(Tcl_Obj *));
+	leftovers[0] = objv[0];
     } else {
 	nrem = 0;
 	leftovers = NULL;
@@ -1182,14 +1184,7 @@ Tcl_ParseArgsObjv(
 	    }
 
 	    dstIndex++;		/* This argument is now handled */
-	    nrem++;
-
-	    /*
-	     * Allocate nrem (+1 extra for NULL terminator) pointers.
-	     */
-
-	    leftovers = ckrealloc(leftovers, (nrem+1) * sizeof(Tcl_Obj *));
-	    leftovers[nrem-1] = curArg;
+	    leftovers[nrem++] = curArg;
 	    continue;
 	}
 
@@ -1227,7 +1222,14 @@ Tcl_ParseArgsObjv(
 	    objc--;
 	    break;
 	case TCL_ARGV_REST:
-	    *((int *) infoPtr->dstPtr) = dstIndex;
+	    /*
+	     * Only store the point where we got to if it's not to be written
+	     * to NULL, so that TCL_ARGV_AUTO_REST works.
+	     */
+
+	    if (infoPtr->dstPtr != NULL) {
+		*((int *) infoPtr->dstPtr) = dstIndex;
+	    }
 	    goto argsDone;
 	case TCL_ARGV_FLOAT:
 	    if (objc == 0) {
@@ -1282,7 +1284,9 @@ Tcl_ParseArgsObjv(
 
     /*
      * If we broke out of the loop because of an OPT_REST argument, copy the
-     * remaining arguments down.
+     * remaining arguments down. Note that there is always at least one
+     * argument left over - the command name - so we always have a result if
+     * our caller is willing to receive it. [Bug 3413857]
      */
 
   argsDone:
@@ -1295,19 +1299,12 @@ Tcl_ParseArgsObjv(
     }
 
     if (objc > 0) {
-	leftovers = ckrealloc(leftovers, (nrem+objc+1) * sizeof(Tcl_Obj *));
-	while (objc) {
-	    leftovers[nrem] = objv[srcIndex];
-	    nrem++;
-	    srcIndex++;
-	    objc--;
-	}
-    } else if (leftovers != NULL) {
-	ckfree(leftovers);
+	memcpy(leftovers+nrem, objv+srcIndex, objc*sizeof(Tcl_Obj *));
+	nrem += objc;
     }
     leftovers[nrem] = NULL;
-    *objcPtr = nrem;
-    *remObjv = leftovers;
+    *objcPtr = nrem++;
+    *remObjv = ckrealloc(leftovers, nrem * sizeof(Tcl_Obj *));
     return TCL_OK;
 
     /*
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 96dcb36..5b74663 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -311,6 +311,8 @@ static int		TestpanicCmd(ClientData dummy,
 static int		TestfinexitObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+static int              TestparseargsCmd(ClientData dummy, Tcl_Interp *interp,
+                            int objc, Tcl_Obj *const objv[]);
 static int		TestparserObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -624,6 +626,7 @@ Tcltest_Init(
 	    NULL);
     Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL);
     Tcl_CreateObjCommand(interp, "testfinexit", TestfinexitObjCmd, NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL);
     Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd,
 	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd,
@@ -7082,6 +7085,48 @@ TestconcatobjCmd(
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * TestparseargsCmd --
+ *
+ *	This procedure implements the "testparseargs" command. It is used to
+ *	test that Tcl_ParseArgsObjv does indeed return the right number of
+ *	arguments. In other words, that [Bug 3413857] was fixed properly.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestparseargsCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Arguments. */
+{
+    int count = objc, foo = 0;
+    Tcl_Obj **remObjv, *result[3];
+    Tcl_ArgvInfo argTable[] = {
+        {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL},
+        TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END
+    };
+
+    if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) {
+        return TCL_ERROR;
+    }
+    result[0] = Tcl_NewIntObj(foo);
+    result[1] = Tcl_NewIntObj(count);
+    result[2] = Tcl_NewListObj(count, remObjv);
+    Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
+    return TCL_OK;
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/tests/indexObj.test b/tests/indexObj.test
index 098aec0..479cc3b 100644
--- a/tests/indexObj.test
+++ b/tests/indexObj.test
@@ -1,20 +1,21 @@
 # This file is a Tcl script to test out the the procedures in file
-# tkIndexObj.c, which implement indexed table lookups.  The tests here
-# are organized in the standard fashion for Tcl tests.
+# tkIndexObj.c, which implement indexed table lookups.  The tests here are
+# organized in the standard fashion for Tcl tests.
 #
 # Copyright (c) 1997 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
 testConstraint testindexobj [llength [info commands testindexobj]]
-
+testConstraint testparseargs [llength [info commands testparseargs]]
+
 test indexObj-1.1 {exact match} testindexobj {
     testindexobj 1 1 xyz abc def xyz alm
 } {2}
@@ -128,6 +129,31 @@ test indexObj-6.4 {Tcl_GetIndexFromObjStruct} testindexobj {
     testgetindexfromobjstruct $x 1
 } "wrong # args: should be \"testgetindexfromobjstruct c 1\""
 
+test indexObj-7.1 {Tcl_ParseArgsObjv} testparseargs {
+    testparseargs
+} {0 1 testparseargs}
+test indexObj-7.2 {Tcl_ParseArgsObjv} testparseargs {
+    testparseargs -bool
+} {1 1 testparseargs}
+test indexObj-7.3 {Tcl_ParseArgsObjv} testparseargs {
+    testparseargs -bool bar
+} {1 2 {testparseargs bar}}
+test indexObj-7.4 {Tcl_ParseArgsObjv} testparseargs {
+    testparseargs bar
+} {0 2 {testparseargs bar}}
+test indexObj-7.5 {Tcl_ParseArgsObjv} -constraints testparseargs -body {
+    testparseargs -help
+} -returnCodes error -result {Command-specific options:
+ -bool: booltest
+ --:    Marks the end of the options
+ -help: Print summary of command-line options and abort}
+test indexObj-7.6 {Tcl_ParseArgsObjv} testparseargs {
+    testparseargs -- -bool -help
+} {0 3 {testparseargs -bool -help}}
+test indexObj-7.7 {Tcl_ParseArgsObjv memory management} testparseargs {
+    testparseargs 1 2 3 4 5 6 7 8 9 0 -bool 1 2 3 4 5 6 7 8 9 0
+} {1 21 {testparseargs 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0}}
+
 # cleanup
 ::tcltest::cleanupTests
 return