summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2021-12-16 12:09:11 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2021-12-16 12:09:11 (GMT)
commit22325d1e0843a7d1511f7ec81a4958939ab3faaf (patch)
tree137d164cf8f730a6c0d784808ce2bf287fff0de0
parentfcc9c57804bed50e0acafd815c13b3426cb3f3d2 (diff)
downloadtcl-22325d1e0843a7d1511f7ec81a4958939ab3faaf.zip
tcl-22325d1e0843a7d1511f7ec81a4958939ab3faaf.tar.gz
tcl-22325d1e0843a7d1511f7ec81a4958939ab3faaf.tar.bz2
Add 2 new testcases, for Tcl_GetIndexFromObjStruct with TCL_EXACT flag and for Tcl_GetIndexFromObjStruct with NULL argument
-rw-r--r--generic/tclIndexObj.c8
-rw-r--r--generic/tclTest.c27
-rw-r--r--tests/indexObj.test32
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