diff options
| -rw-r--r-- | doc/ParseArgs.3 | 14 | ||||
| -rw-r--r-- | generic/tcl.h | 4 | ||||
| -rw-r--r-- | generic/tclIndexObj.c | 8 | ||||
| -rw-r--r-- | generic/tclTest.c | 34 | ||||
| -rw-r--r-- | tests/indexObj.test | 37 |
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 |