Combine with "testparseargs" command. With testcases now

1 files changed, 32 insertions, 81 deletions

diff --git a/generic/tclTest.c b/generic/tclTest.c
index 5491d80..cc193ef 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -246,7 +246,6 @@ static Tcl_ObjCmdProc	TestbumpinterpepochObjCmd;
 static Tcl_ObjCmdProc	TestbytestringObjCmd;
 static Tcl_ObjCmdProc	TestsetbytearraylengthObjCmd;
 static Tcl_ObjCmdProc	TestpurebytesobjObjCmd;
-static Tcl_ObjCmdProc	TestparseargsObjCmd;
 static Tcl_ObjCmdProc	TeststringbytesObjCmd;
 static Tcl_ObjCmdProc	Testutf16stringObjCmd;
 static Tcl_ObjCmdProc	TestcmdinfoObjCmd;
@@ -593,7 +592,6 @@ Tcltest_Init(
     Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL);
     Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL);
     Tcl_CreateObjCommand(interp, "testpurebytesobj", TestpurebytesobjObjCmd, NULL, NULL);
-    Tcl_CreateObjCommand(interp, "testparseargsobj", TestparseargsObjCmd, NULL, NULL);
     Tcl_CreateObjCommand(interp, "testsetbytearraylength", TestsetbytearraylengthObjCmd, NULL, NULL);
     Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL);
     Tcl_CreateObjCommand(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL);
@@ -5645,83 +5643,6 @@ TestpurebytesobjObjCmd(
 /*
  *----------------------------------------------------------------------
  *
- * TestparseargsObjCmd --
- *
- *	This object-based procedure tests the TCL_ARGV_GENFUNC functionality.
- *
- * Results:
- *	Returns the TCL_OK result code.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ParseMedia(
-    TCL_UNUSED(void *),
-    Tcl_Interp *interp,
-    TCL_UNUSED(int),
-    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
-TestparseargsObjCmd(
-    TCL_UNUSED(void *),
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_Size count;
-
-    const char *media = NULL, *color = NULL;
-
-    const Tcl_ArgvInfo argTable[] = {
-	{TCL_ARGV_STRING,  "-colormode" ,  NULL, &color,  "color mode", NULL},
-	{TCL_ARGV_GENFUNC, "-media", ParseMedia, &media,  "media page size", NULL},
-	TCL_ARGV_TABLE_END
-    };
-
-    if (objc%2 != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?-opt arg ...?");
-	return TCL_ERROR;
-    }
-
-    count = objc;
-
-    if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, NULL)!=TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    /* show color and media parsed values */
-    Tcl_SetObjResult(interp, Tcl_ObjPrintf("Color: |%d|%s|, Media: |%d|%s|",
-	color?1:0, color?color:"NO COLOR",
-	media?1:0, media?media:"NO MEDIA"
-    ));
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TestsetbytearraylengthObjCmd --
  *
  *	Testing command 'testsetbytearraylength` used to test the public
@@ -8483,6 +8404,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.
@@ -8494,6 +8416,30 @@ TestconcatobjCmd(
  */
 
 static int
+ParseMedia(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    TCL_UNUSED(int),
+    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 *),
     Tcl_Interp *interp,		/* Current interpreter. */
@@ -8501,10 +8447,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
     };
 
@@ -8515,7 +8464,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));
     ckfree(remObjv);
     return TCL_OK;
 }