summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/ParseArgs.314
-rw-r--r--generic/tcl.h4
-rw-r--r--generic/tclIndexObj.c8
-rw-r--r--generic/tclTest.c34
-rw-r--r--tests/indexObj.test37
5 files changed, 74 insertions, 23 deletions
diff --git a/doc/ParseArgs.3 b/doc/ParseArgs.3
index edc0bc0..594f4f1 100644
--- a/doc/ParseArgs.3
+++ b/doc/ParseArgs.3
@@ -138,19 +138,19 @@ function will have the following signature:
.RS
.PP
.CS
-typedef int (\fBTcl_ArgvGenFuncProc\fR)(
+typedef Tcl_Size (\fBTcl_ArgvGenFuncProc\fR)(
void *\fIclientData\fR,
Tcl_Interp *\fIinterp\fR,
- int \fIobjc\fR,
+ Tcl_Size \fIobjc\fR,
Tcl_Obj *const *\fIobjv\fR,
void *\fIdstPtr\fR);
.CE
.PP
-The \fIclientData\fR is the value from the table entry, the \fIinterp\fR is
-where to store any error messages, the \fIkeyStr\fR is the name of the
-argument, \fIobjc\fR and \fIobjv\fR describe an array of all the remaining
-arguments, and \fIdstPtr\fR argument to the \fBTcl_ArgvGenFuncProc\fR is the
-location to write the parsed value (or values) to.
+The \fIclientData\fR is the value from the table entry, the \fIinterp\fR
+is where to store any error messages, \fIobjc\fR and \fIobjv\fR describe
+an array of all the remaining arguments, and \fIdstPtr\fR argument to the
+\fBTcl_ArgvGenFuncProc\fR is the location to write the parsed value
+(or values) to.
.RE
.IP \fBTCL_ARGV_HELP\fR
This special argument does not take any following value argument, but instead
diff --git a/generic/tcl.h b/generic/tcl.h
index 059b7a4..16bfd2f 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2190,8 +2190,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 Tcl_Size (Tcl_ArgvGenFuncProc)(void *clientData, Tcl_Interp *interp,
+ Tcl_Size objc, Tcl_Obj *const *objv, void *dstPtr);
/*
* Shorthand for commonly used argTable entries.
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 7e67fa4..3e92b5a 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -1020,6 +1020,7 @@ Tcl_ParseArgsObjv(
* reporting. */
Tcl_Size objc; /* # arguments in objv still to process. */
Tcl_Size length; /* Number of characters in current argument */
+ Tcl_Size gf_ret; /* Return value from Tcl_ArgvGenFuncProc*/
if (remObjv != NULL) {
/*
@@ -1181,10 +1182,13 @@ Tcl_ParseArgsObjv(
Tcl_ArgvGenFuncProc *handlerProc = (Tcl_ArgvGenFuncProc *)
infoPtr->srcPtr;
- objc = handlerProc(infoPtr->clientData, interp, (int)objc,
+ gf_ret = handlerProc(infoPtr->clientData, interp, objc,
&objv[srcIndex], infoPtr->dstPtr);
- if (objc < 0) {
+ if (gf_ret < 0) {
goto error;
+ } else {
+ srcIndex += gf_ret;
+ objc -= gf_ret;
}
break;
}
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 3a6bce5..10c17c7 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -8268,6 +8268,7 @@ TestconcatobjCmd(
* 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.
+ * Also test for bug [7cb7409e05]
*
* Results:
* A standard Tcl result.
@@ -8278,6 +8279,30 @@ TestconcatobjCmd(
*----------------------------------------------------------------------
*/
+static Tcl_Size
+ParseMedia(
+ TCL_UNUSED(void *),
+ Tcl_Interp *interp,
+ TCL_UNUSED(Tcl_Size),
+ Tcl_Obj *const *objv,
+ void *dstPtr)
+{
+ static const char *const mediaOpts[] = {"A4", "Legal", "Letter", NULL};
+ static const char *const ExtendedMediaOpts[] = {
+ "Paper size is ISO A4", "Paper size is US Legal",
+ "Paper size is US Letter", NULL};
+ int index;
+ const char **media = (const char **) dstPtr;
+
+ if (Tcl_GetIndexFromObjStruct(interp, objv[0], mediaOpts,
+ sizeof(char *), "media", 0, &index) != TCL_OK) {
+ return -1;
+ }
+
+ *media = ExtendedMediaOpts[index];
+ return 1;
+}
+
static int
TestparseargsCmd(
TCL_UNUSED(void *),
@@ -8286,10 +8311,13 @@ TestparseargsCmd(
Tcl_Obj *const objv[]) /* Arguments. */
{
static int foo = 0;
+ const char *media = NULL, *color = NULL;
Tcl_Size count = objc;
- Tcl_Obj **remObjv, *result[3];
+ Tcl_Obj **remObjv, *result[5];
const Tcl_ArgvInfo argTable[] = {
{TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL},
+ {TCL_ARGV_STRING, "-colormode" , NULL, &color, "color mode", NULL},
+ {TCL_ARGV_GENFUNC, "-media", ParseMedia, &media, "media page size", NULL},
TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END
};
@@ -8300,7 +8328,9 @@ TestparseargsCmd(
result[0] = Tcl_NewWideIntObj(foo);
result[1] = Tcl_NewWideIntObj(count);
result[2] = Tcl_NewListObj(count, remObjv);
- Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
+ result[3] = Tcl_NewStringObj(color ? color : "NULL", -1);
+ result[4] = Tcl_NewStringObj(media ? media : "NULL", -1);
+ Tcl_SetObjResult(interp, Tcl_NewListObj(5, result));
Tcl_Free(remObjv);
return TCL_OK;
}
diff --git a/tests/indexObj.test b/tests/indexObj.test
index f157637..cf0f7df 100644
--- a/tests/indexObj.test
+++ b/tests/indexObj.test
@@ -149,29 +149,46 @@ test indexObj-6.7 {Tcl_GetIndexFromObjStruct} testindexobj {
test indexObj-7.1 {Tcl_ParseArgsObjv} testparseargs {
testparseargs
-} {0 1 testparseargs}
+} {0 1 testparseargs NULL NULL}
test indexObj-7.2 {Tcl_ParseArgsObjv} testparseargs {
testparseargs -bool
-} {1 1 testparseargs}
+} {1 1 testparseargs NULL NULL}
test indexObj-7.3 {Tcl_ParseArgsObjv} testparseargs {
testparseargs -bool bar
-} {1 2 {testparseargs bar}}
+} {1 2 {testparseargs bar} NULL NULL}
test indexObj-7.4 {Tcl_ParseArgsObjv} testparseargs {
testparseargs bar
-} {0 2 {testparseargs bar}}
+} {0 2 {testparseargs bar} NULL NULL}
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}
+ -bool: booltest
+ -colormode: color mode
+ -media: media page size
+ --: 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}}
+} {0 3 {testparseargs -bool -help} NULL NULL}
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}}
-
+} {1 21 {testparseargs 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0} NULL NULL}
+test indexObj-7.8 {Tcl_ParseArgsObjv} testparseargs {
+ testparseargs -color Nothing
+} {0 1 testparseargs Nothing NULL}
+test indexObj-7.9 {Tcl_ParseArgsObjv} testparseargs {
+ testparseargs -media A4
+} {0 1 testparseargs NULL {Paper size is ISO A4}}
+test indexObj-7.10 {Tcl_ParseArgsObjv} testparseargs {
+ testparseargs -media A4 -color Somecolor
+} {0 1 testparseargs Somecolor {Paper size is ISO A4}}
+test indexObj-7.11 {Tcl_ParseArgsObjv} testparseargs {
+ testparseargs -color othercolor -media Letter
+} {0 1 testparseargs othercolor {Paper size is US Letter}}
+test indexObj-7.12 {Tcl_ParseArgsObjv} -constraints testparseargs -body {
+ testparseargs -color othercolor -media Nosuchmedia
+} -returnCodes error -result {bad media "Nosuchmedia": must be A4, Legal, or Letter}
+
test indexObj-8.1 {Tcl_GetIntForIndex integer} testgetintforindex {
testgetintforindex 0 0
} 0
generated by cgit v0.12 at 2024-11-16 12:28:26 (GMT)