From 22325d1e0843a7d1511f7ec81a4958939ab3faaf Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 16 Dec 2021 12:09:11 +0000 Subject: Add 2 new testcases, for Tcl_GetIndexFromObjStruct with TCL_EXACT flag and for Tcl_GetIndexFromObjStruct with NULL argument --- generic/tclIndexObj.c | 8 ++++---- generic/tclTest.c | 27 +++++++++++++++------------ tests/indexObj.test | 32 ++++++++++++++++++++------------ 3 files changed, 39 insertions(+), 28 deletions(-) diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index e2969c2..efa7373 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -105,7 +105,7 @@ int Tcl_GetIndexFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* Object containing the string to lookup. */ - const char *const*tablePtr, /* Array of strings to compare against the + const char *const *tablePtr, /* Array of strings to compare against the * value of objPtr; last entry must be NULL * and there must not be duplicate entries. */ const char *msg, /* Identifying word to use in error @@ -128,7 +128,7 @@ Tcl_GetIndexFromObj( * on odd platforms like a Cray PVP... */ - if (indexRep->tablePtr == (void *) tablePtr + if (indexRep->tablePtr == (void *)tablePtr && indexRep->offset == sizeof(char *)) { *indexPtr = indexRep->index; return TCL_OK; @@ -302,7 +302,7 @@ Tcl_GetIndexFromObjStruct( * - Several abbreviations (never allowed, but overridden by exact match) */ - for (entryPtr = (const char* const*)tablePtr, idx = 0; *entryPtr != NULL; + for (entryPtr = (const char *const *)tablePtr, idx = 0; *entryPtr != NULL; entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) { for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) { if (*p1 == '\0') { @@ -365,7 +365,7 @@ Tcl_GetIndexFromObjStruct( int count = 0; TclNewObj(resultPtr); - entryPtr = (const char* const *)tablePtr; + entryPtr = (const char *const *)tablePtr; while ((*entryPtr != NULL) && !**entryPtr) { entryPtr = NEXT_ENTRY(entryPtr, offset); } diff --git a/generic/tclTest.c b/generic/tclTest.c index a759e74..5774dfc 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -1622,7 +1622,7 @@ TestdoubledigitsObjCmd(ClientData unused, Tcl_Obj* const objv[]) /* Parameter vector */ { - static const char* options[] = { + static const char *options[] = { "shortest", "Steele", "e", @@ -1643,8 +1643,8 @@ TestdoubledigitsObjCmd(ClientData unused, int type; int decpt; int signum; - char* str; - char* endPtr; + char * str; + char *endPtr; Tcl_Obj* strObj; Tcl_Obj* retval; @@ -1759,7 +1759,7 @@ TestdstringCmd( strcpy(s, "This is a malloc-ed string"); Tcl_SetResult(interp, s, TCL_DYNAMIC); } else if (strcmp(argv[2], "special") == 0) { - char *s = (char*)ckalloc(100) + 16; + char *s = (char *)ckalloc(100) + 16; strcpy(s, "This is a specially-allocated string"); Tcl_SetResult(interp, s, SpecialFree); } else { @@ -6176,19 +6176,22 @@ TestGetIndexFromObjStructObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { const char *const ary[] = { - "a", "b", "c", "d", "e", "f", NULL, NULL + "a", "b", "c", "d", "ee", "ff", NULL, NULL }; - int idx,target; + int idx,target, flags = 0; - if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "argument targetvalue"); + if (objc != 3 && objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "argument targetvalue ?flags?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObjStruct(interp, objv[1], ary, 2*sizeof(char *), - "dummy", 0, &idx) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[2], &target) != TCL_OK) { return TCL_ERROR; } - if (Tcl_GetIntFromObj(interp, objv[2], &target) != TCL_OK) { + if ((objc > 3) && (Tcl_GetIntFromObj(interp, objv[3], &flags) != TCL_OK)) { + return TCL_ERROR; + } + if (Tcl_GetIndexFromObjStruct(interp, (Tcl_GetString(objv[1])[0] ? objv[1] : NULL), ary, 2*sizeof(char *), + "dummy", flags, &idx) != TCL_OK) { return TCL_ERROR; } if (idx != target) { @@ -6200,7 +6203,7 @@ TestGetIndexFromObjStructObjCmd( Tcl_AppendResult(interp, " when ", buffer, " expected", NULL); return TCL_ERROR; } - Tcl_WrongNumArgs(interp, 3, objv, NULL); + Tcl_WrongNumArgs(interp, objc, objv, NULL); return TCL_OK; } diff --git a/tests/indexObj.test b/tests/indexObj.test index 60ee61a..b992373 100644 --- a/tests/indexObj.test +++ b/tests/indexObj.test @@ -3,7 +3,7 @@ # organized in the standard fashion for Tcl tests. # # Copyright (c) 1997 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 1998-1999 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -91,46 +91,54 @@ test indexObj-4.1 {free old internal representation} testindexobj { test indexObj-5.1 {Tcl_WrongNumArgs} testindexobj { testwrongnumargs 1 "?-switch?" mycmd -} "wrong # args: should be \"mycmd ?-switch?\"" +} {wrong # args: should be "mycmd ?-switch?"} test indexObj-5.2 {Tcl_WrongNumArgs} testindexobj { testwrongnumargs 2 "bar" mycmd foo -} "wrong # args: should be \"mycmd foo bar\"" +} {wrong # args: should be "mycmd foo bar"} test indexObj-5.3 {Tcl_WrongNumArgs} testindexobj { testwrongnumargs 0 "bar" mycmd foo -} "wrong # args: should be \"bar\"" +} {wrong # args: should be "bar"} test indexObj-5.4 {Tcl_WrongNumArgs} testindexobj { testwrongnumargs 0 "" mycmd foo -} "wrong # args: should be \"\"" +} {wrong # args: should be ""} test indexObj-5.5 {Tcl_WrongNumArgs} testindexobj { testwrongnumargs 1 "" mycmd foo -} "wrong # args: should be \"mycmd\"" +} {wrong # args: should be "mycmd"} test indexObj-5.6 {Tcl_WrongNumArgs} testindexobj { testwrongnumargs 2 "" mycmd foo -} "wrong # args: should be \"mycmd foo\"" +} {wrong # args: should be "mycmd foo"} # Contrast this with test proc-3.6; they have to be like this because # of [Bug 1066837] so Itcl won't break. test indexObj-5.7 {Tcl_WrongNumArgs} testindexobj { testwrongnumargs 2 "fee fi" "fo fum" foo bar -} "wrong # args: should be \"fo fum foo fee fi\"" +} {wrong # args: should be "fo fum foo fee fi"} test indexObj-6.1 {Tcl_GetIndexFromObjStruct} testindexobj { set x a testgetindexfromobjstruct $x 0 -} "wrong # args: should be \"testgetindexfromobjstruct a 0\"" +} {wrong # args: should be "testgetindexfromobjstruct a 0"} test indexObj-6.2 {Tcl_GetIndexFromObjStruct} testindexobj { set x a testgetindexfromobjstruct $x 0 testgetindexfromobjstruct $x 0 -} "wrong # args: should be \"testgetindexfromobjstruct a 0\"" +} {wrong # args: should be "testgetindexfromobjstruct a 0"} test indexObj-6.3 {Tcl_GetIndexFromObjStruct} testindexobj { set x c testgetindexfromobjstruct $x 1 -} "wrong # args: should be \"testgetindexfromobjstruct c 1\"" +} {wrong # args: should be "testgetindexfromobjstruct c 1"} test indexObj-6.4 {Tcl_GetIndexFromObjStruct} testindexobj { set x c testgetindexfromobjstruct $x 1 testgetindexfromobjstruct $x 1 -} "wrong # args: should be \"testgetindexfromobjstruct c 1\"" +} {wrong # args: should be "testgetindexfromobjstruct c 1"} +test indexObj-6.5 {Tcl_GetIndexFromObjStruct with TCL_EXACT flag} -constraints testindexobj -body { + set x e + testgetindexfromobjstruct $x 0 1 +} -returnCodes error -result {bad dummy "e": must be a, c, or ee} +test indexObj-6.6 {Tcl_GetIndexFromObjStruct with NULL input} -constraints testindexobj -body { + set x "" + testgetindexfromobjstruct $x 0 +} -returnCodes error -result {ambiguous dummy "": must be a, c, or ee} test indexObj-7.1 {Tcl_ParseArgsObjv} testparseargs { testparseargs -- cgit v0.12