From 7769b8861e967901e3687c387ed3724ee84d3b0e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 4 Apr 2024 20:01:44 +0000 Subject: Combine with "testparseargs" command. With testcases now --- generic/tclTest.c | 113 +++++++++++++++------------------------------------- tests/indexObj.test | 37 ++++++++++++----- 2 files changed, 59 insertions(+), 91 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; } diff --git a/tests/indexObj.test b/tests/indexObj.test index 1cf782a..eec5485 100644 --- a/tests/indexObj.test +++ b/tests/indexObj.test @@ -147,29 +147,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 -- cgit v0.12