Merge 8.6

3 files changed, 45 insertions, 34 deletions

diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 5e44a9c..d9639ff 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -25,13 +25,13 @@ static int		GetIndexFromObjList(Tcl_Interp *interp,
 static void		UpdateStringOfIndex(Tcl_Obj *objPtr);
 static void		DupIndex(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
 static void		FreeIndex(Tcl_Obj *objPtr);
-static int		PrefixAllObjCmd(ClientData clientData,
+static int		PrefixAllObjCmd(void *clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
-static int		PrefixLongestObjCmd(ClientData clientData,
+static int		PrefixLongestObjCmd(void *clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
-static int		PrefixMatchObjCmd(ClientData clientData,
+static int		PrefixMatchObjCmd(void *clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
 static void		PrintUsage(Tcl_Interp *interp,
@@ -106,7 +106,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
@@ -132,7 +132,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;
@@ -307,7 +307,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') {
@@ -372,7 +372,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);
 	}
@@ -540,7 +540,7 @@ TclInitPrefixCmd(
 
 static int
 PrefixMatchObjCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
@@ -664,7 +664,7 @@ PrefixMatchObjCmd(
 
 static int
 PrefixAllObjCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
@@ -721,7 +721,7 @@ PrefixAllObjCmd(
 
 static int
 PrefixLongestObjCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
@@ -851,7 +851,7 @@ Tcl_WrongNumArgs(
     Tcl_Obj *objPtr;
     int i, len, elemLen;
     char flags;
-    Interp *iPtr = (Interp *) interp;
+    Interp *iPtr = (Interp *)interp;
     const char *elementStr;
 
     /*
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 46a1459..0ac79a6 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -1617,7 +1617,7 @@ TestdoubledigitsObjCmd(
     int objc,			/* Parameter count */
     Tcl_Obj* const objv[])	/* Parameter vector */
 {
-    static const char* options[] = {
+    static const char *options[] = {
 	"shortest",
 	"e",
 	"f",
@@ -1636,8 +1636,8 @@ TestdoubledigitsObjCmd(
     int type;
     int decpt;
     int signum;
-    char* str;
-    char* endPtr;
+    char *str;
+    char *endPtr;
     Tcl_Obj* strObj;
     Tcl_Obj* retval;
 
@@ -1752,7 +1752,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 {
@@ -6283,19 +6283,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) {
@@ -6307,7 +6310,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 bd6a2c2..40418b3 100644
--- a/tests/indexObj.test
+++ b/tests/indexObj.test
@@ -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 obsolete} {
     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