diff options
| -rw-r--r-- | generic/tclTest.c | 79 |
1 files changed, 79 insertions, 0 deletions
diff --git a/generic/tclTest.c b/generic/tclTest.c index 007d51a..5491d80 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -246,6 +246,7 @@ 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; @@ -592,6 +593,7 @@ 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); @@ -5643,6 +5645,83 @@ 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 |