summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2011-09-27 09:49:06 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2011-09-27 09:49:06 (GMT)
commitaf95a5aaa6aa271a32f7efadf348486edff6d9c6 (patch)
tree84f6ad4f5a3f892a9fe948d58e9b07197247fefd /generic
parent643c7a2aa4c7b5cb1412a098ecacd72dc5f09aac (diff)
parenta235eed74f319d7860e973935e2064bd1bb30e18 (diff)
downloadtcl-af95a5aaa6aa271a32f7efadf348486edff6d9c6.zip
tcl-af95a5aaa6aa271a32f7efadf348486edff6d9c6.tar.gz
tcl-af95a5aaa6aa271a32f7efadf348486edff6d9c6.tar.bz2
* 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.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclIndexObj.c47
-rw-r--r--generic/tclTest.c45
2 files changed, 67 insertions, 25 deletions
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