Implement TIP #613: New INDEX_NULL_OK flag for Tcl_GetIndexFromObj*()

5 files changed, 57 insertions, 18 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index bd9800a..c137a88 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -1092,7 +1092,7 @@ declare 303 {
 declare 304 {
     int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr,
 	    const void *tablePtr, int offset, const char *msg, int flags,
-	    int *indexPtr)
+	    void *indexPtr)
 }
 declare 305 {
     void *Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size)
diff --git a/generic/tcl.h b/generic/tcl.h
index 346b79c..b82cf0a 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -979,10 +979,13 @@ typedef struct Tcl_DString {
  * TCL_EXACT disallows abbreviated strings.
  * TCL_INDEX_TEMP_TABLE disallows caching of lookups. A possible use case is
  *      a table that will not live long enough to make it worthwhile.
+ * TCL_INDEX_NULL_OK allows the empty string or NULL to return TCL_OK.
+ *      The returned value will be -1;
  */
 
 #define TCL_EXACT		1
 #define TCL_INDEX_TEMP_TABLE	2
+#define TCL_INDEX_NULL_OK	4
 
 /*
  *----------------------------------------------------------------------------
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index f1962b2..b5697ea 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -945,7 +945,7 @@ EXTERN void		Tcl_GetEncodingNames(Tcl_Interp *interp);
 EXTERN int		Tcl_GetIndexFromObjStruct(Tcl_Interp *interp,
 				Tcl_Obj *objPtr, const void *tablePtr,
 				int offset, const char *msg, int flags,
-				int *indexPtr);
+				void *indexPtr);
 /* 305 */
 EXTERN void *		Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr,
 				int size);
@@ -2287,7 +2287,7 @@ typedef struct TclStubs {
     Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */
     const char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
     void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */
-    int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 304 */
+    int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, void *indexPtr); /* 304 */
     void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */
     Tcl_Obj * (*tcl_GetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 306 */
     ClientData (*tcl_InitNotifier) (void); /* 307 */
@@ -4209,6 +4209,7 @@ extern const TclStubs *tclStubsPtr;
 #define Tcl_GetUnicode(objPtr) \
 	Tcl_GetUnicodeFromObj(objPtr, (int *)NULL)
 #undef Tcl_GetBytesFromObj
+#undef Tcl_GetIndexFromObjStruct
 #ifdef TCL_NO_DEPRECATED
 #undef Tcl_GetStringFromObj
 #undef Tcl_GetUnicodeFromObj
@@ -4217,6 +4218,8 @@ extern const TclStubs *tclStubsPtr;
 #if defined(USE_TCL_STUBS)
 #define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
 	(sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (size_t *)sizePtr))
+#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
+	(tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*indexPtr)<<8), (indexPtr)))
 #ifdef TCL_NO_DEPRECATED
 #define Tcl_GetStringFromObj(objPtr, sizePtr) \
 	(sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetStringFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetStringFromObj(objPtr, (size_t *)sizePtr))
@@ -4228,6 +4231,8 @@ extern const TclStubs *tclStubsPtr;
 #else
 #define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
 	(sizeof(*sizePtr) <= sizeof(int) ? (TclGetBytesFromObj)(interp, objPtr, (int *)sizePtr) : (Tcl_GetBytesFromObj)(interp, objPtr, (size_t *)sizePtr))
+#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
+	((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*indexPtr)<<8), (indexPtr)))
 #ifdef TCL_NO_DEPRECATED
 #define Tcl_GetStringFromObj(objPtr, sizePtr) \
 	(sizeof(*sizePtr) <= sizeof(int) ? (Tcl_GetStringFromObj)(objPtr, (int *)sizePtr) : (TclGetStringFromObj)(objPtr, (size_t *)sizePtr))
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 9f1058a..1f600c5 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -235,11 +235,12 @@ GetIndexFromObjList(
  * Results:
  *	If the value of objPtr is identical to or a unique abbreviation for
  *	one of the entries in tablePtr, then the return value is TCL_OK and
- *	the index of the matching entry is stored at *indexPtr. If there isn't
- *	a proper match, then TCL_ERROR is returned and an error message is
- *	left in interp's result (unless interp is NULL). The msg argument is
- *	used in the error message; for example, if msg has the value "option"
- *	then the error message will say something like 'bad option "foo": must
+ *	the index of the matching entry is stored at *indexPtr
+ *	(unless indexPtr is NULL). If there isn't a proper match, then
+ *	TCL_ERROR is returned and an error message is left in interp's
+ *	result (unless interp is NULL). The msg argument is used in the
+ *	error message; for example, if msg has the value "option" then
+ *	the error message will say something like 'bad option "foo": must
  *	be ...'
  *
  * Side effects:
@@ -249,6 +250,7 @@ GetIndexFromObjList(
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_GetIndexFromObjStruct
 int
 Tcl_GetIndexFromObjStruct(
     Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
@@ -261,8 +263,8 @@ Tcl_GetIndexFromObjStruct(
     int offset,			/* The number of bytes between entries */
     const char *msg,		/* Identifying word to use in error
 				 * messages. */
-    int flags,			/* 0, TCL_EXACT or TCL_INDEX_TEMP_TABLE */
-    int *indexPtr)		/* Place to store resulting integer index. */
+    int flags,			/* 0, TCL_EXACT, TCL_INDEX_TEMP_TABLE or TCL_INDEX_NULL_OK */
+    void *indexPtr)		/* Place to store resulting index. */
 {
     int index, idx, numAbbrev;
     const char *key, *p1;
@@ -287,8 +289,8 @@ Tcl_GetIndexFromObjStruct(
 	if ((indexRep->tablePtr == tablePtr)
 		&& (indexRep->offset == offset)
 		&& (indexRep->index >= 0)) {
-	    *indexPtr = indexRep->index;
-	    return TCL_OK;
+	    index = indexRep->index;
+	    goto uncachedDone;
 	}
     }
     }
@@ -302,6 +304,9 @@ Tcl_GetIndexFromObjStruct(
     index = -1;
     numAbbrev = 0;
 
+    if (!*key && (flags & TCL_INDEX_NULL_OK)) {
+	goto uncachedDone;
+    }
     /*
      * Scan the table looking for one of:
      *  - An exact match (always preferred)
@@ -362,7 +367,25 @@ Tcl_GetIndexFromObjStruct(
     indexRep->index = index;
     }
 
-    *indexPtr = index;
+  uncachedDone:
+    if (indexPtr != NULL) {
+	if ((flags>>8) & (int)~sizeof(int)) {
+	    if ((flags>>8) == sizeof(uint64_t)) {
+		*(uint64_t *)indexPtr = index;
+		return TCL_OK;
+	    } else if ((flags>>8) == sizeof(uint32_t)) {
+		*(uint32_t *)indexPtr = index;
+		return TCL_OK;
+	    } else if ((flags>>8) == sizeof(uint16_t)) {
+		*(uint16_t *)indexPtr = index;
+		return TCL_OK;
+	    } else if ((flags>>8) == sizeof(uint8_t)) {
+		*(uint8_t *)indexPtr = index;
+		return TCL_OK;
+	}
+	}
+	*(int *)indexPtr = index;
+    }
     return TCL_OK;
 
   error:
@@ -388,7 +411,7 @@ Tcl_GetIndexFromObjStruct(
 		    *entryPtr, NULL);
 	    entryPtr = NEXT_ENTRY(entryPtr, offset);
 	    while (*entryPtr != NULL) {
-		if (*NEXT_ENTRY(entryPtr, offset) == NULL) {
+		if ((*NEXT_ENTRY(entryPtr, offset) == NULL) && !(flags & TCL_INDEX_NULL_OK)) {
 		    Tcl_AppendStringsToObj(resultPtr, (count > 0 ? "," : ""),
 			    " or ", *entryPtr, NULL);
 		} else if (**entryPtr) {
@@ -397,6 +420,9 @@ Tcl_GetIndexFromObjStruct(
 		}
 		entryPtr = NEXT_ENTRY(entryPtr, offset);
 	    }
+	    if ((flags & TCL_INDEX_NULL_OK)) {
+		Tcl_AppendStringsToObj(resultPtr, ", or \"\"", NULL);
+	    }
 	}
 	Tcl_SetObjResult(interp, resultPtr);
 	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL);
diff --git a/generic/tclTest.c b/generic/tclTest.c
index c8c3402..0db8587 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -6289,7 +6289,8 @@ TestGetIndexFromObjStructObjCmd(
     const char *const ary[] = {
 	"a", "b", "c", "d", "ee", "ff", NULL, NULL
     };
-    int idx,target, flags = 0;
+    int target, flags = 0;
+    signed char idx[8];
 
     if (objc != 3 && objc != 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "argument targetvalue ?flags?");
@@ -6301,13 +6302,17 @@ TestGetIndexFromObjStructObjCmd(
     if ((objc > 3) && (Tcl_GetIntFromObj(interp, objv[3], &flags) != TCL_OK)) {
 	return TCL_ERROR;
     }
+    memset(idx, 85, sizeof(idx));
     if (Tcl_GetIndexFromObjStruct(interp, (Tcl_GetString(objv[1])[0] ? objv[1] : NULL), ary, 2*sizeof(char *),
-	    "dummy", flags, &idx) != TCL_OK) {
+	    "dummy", flags, &idx[1]) != TCL_OK) {
 	return TCL_ERROR;
     }
-    if (idx != target) {
+    if (idx[0] != 85 || idx[2] != 85) {
+	Tcl_AppendResult(interp, "Tcl_GetIndexFromObjStruct overwrites bytes near index variable", NULL);
+	return TCL_ERROR;
+    } else if (idx[1] != target) {
 	char buffer[64];
-	sprintf(buffer, "%d", idx);
+	sprintf(buffer, "%d", idx[1]);
 	Tcl_AppendResult(interp, "index value comparison failed: got ",
 		buffer, NULL);
 	sprintf(buffer, "%d", target);