summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/GetIndex.318
-rw-r--r--generic/tcl.decls2
-rw-r--r--generic/tcl.h3
-rw-r--r--generic/tclDecls.h9
-rw-r--r--generic/tclIndexObj.c48
-rw-r--r--generic/tclScan.c3
-rw-r--r--generic/tclStrToD.c17
-rw-r--r--generic/tclTest.c13
-rw-r--r--tests/indexObj.test4
9 files changed, 80 insertions, 37 deletions
diff --git a/doc/GetIndex.3 b/doc/GetIndex.3
index a788848..1169c6c 100644
--- a/doc/GetIndex.3
+++ b/doc/GetIndex.3
@@ -54,10 +54,12 @@ Null-terminated string describing what is being looked up, such as
.AP int flags in
OR-ed combination of bits providing additional information for
operation. The only bits that are currently defined are \fBTCL_EXACT\fR
-and \fBTCL_INDEX_TEMP_TABLE\fR.
-.AP int *indexPtr out
-The index of the string in \fItablePtr\fR that matches the value of
-\fIobjPtr\fR is returned here.
+, \fBTCL_INDEX_TEMP_TABLE\fR, and \fBTCL_INDEX_NULL_OK\fR.
+.AP enum|char|short|int|long *indexPtr out
+If not (int *)NULL, the index of the string in \fItablePtr\fR that
+matches the value of \fIobjPtr\fR is returned here. The variable can
+be any integer type, signed or unsigned, char, short, long or
+long long. It can also be an enum.
.BE
.SH DESCRIPTION
.PP
@@ -70,8 +72,8 @@ the strings in \fItablePtr\fR to find a match. A match occurs if
\fItablePtr\fR, or if it is a non-empty unique abbreviation
for exactly one of the strings in \fItablePtr\fR and the
\fBTCL_EXACT\fR flag was not specified; in either case
-the index of the matching entry is stored at \fI*indexPtr\fR
-and \fBTCL_OK\fR is returned.
+\fBTCL_OK\fR is returned. If \fIindexPtr\fR is not NULL the index
+of the matching entry is stored at \fI*indexPtr\fR.
.PP
If there is no matching entry,
\fBTCL_ERROR\fR is returned and an error message is left in \fIinterp\fR's
@@ -91,7 +93,9 @@ operation. Note: \fBTcl_GetIndexFromObj\fR assumes that the entries
in \fItablePtr\fR are static: they must not change between
invocations. This caching mechanism can be disallowed by specifying
the \fBTCL_INDEX_TEMP_TABLE\fR flag.
-If the value of \fIobjPtr\fR is the empty string,
+If the \fBTCL_INDEX_NULL_OK\fR flag was specified, objPtr is allowed
+to be NULL or the empty string. The resulting index is -1.
+Otherwise, if the value of \fIobjPtr\fR is the empty string,
\fBTcl_GetIndexFromObj\fR will treat it as a non-matching value
and return \fBTCL_ERROR\fR.
.PP
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 40598e9..a19ab25 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -1136,7 +1136,7 @@ declare 303 {
declare 304 {
int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr,
const void *tablePtr, size_t offset, const char *msg, int flags,
- int *indexPtr)
+ void *indexPtr)
}
declare 305 {
void *Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, size_t size)
diff --git a/generic/tcl.h b/generic/tcl.h
index c3db670..6b69929 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -826,10 +826,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 e7f9a1f..c5b6bd7 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -809,7 +809,7 @@ EXTERN void Tcl_GetEncodingNames(Tcl_Interp *interp);
EXTERN int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp,
Tcl_Obj *objPtr, const void *tablePtr,
size_t offset, const char *msg, int flags,
- int *indexPtr);
+ void *indexPtr);
/* 305 */
EXTERN void * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr,
size_t size);
@@ -2072,7 +2072,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, size_t offset, const char *msg, int flags, int *indexPtr); /* 304 */
+ int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, size_t offset, const char *msg, int flags, void *indexPtr); /* 304 */
void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, size_t size); /* 305 */
Tcl_Obj * (*tcl_GetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 306 */
void * (*tcl_InitNotifier) (void); /* 307 */
@@ -3832,6 +3832,7 @@ extern const TclStubs *tclStubsPtr;
Tcl_GetStringFromObj(objPtr, (size_t *)NULL)
#define Tcl_GetUnicode(objPtr) \
Tcl_GetUnicodeFromObj(objPtr, (size_t *)NULL)
+#undef Tcl_GetIndexFromObjStruct
#undef Tcl_GetStringFromObj
#undef Tcl_GetUnicodeFromObj
#undef Tcl_GetByteArrayFromObj
@@ -3842,6 +3843,8 @@ extern const TclStubs *tclStubsPtr;
(sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tclGetBytesFromObj(NULL, objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetBytesFromObj(NULL, objPtr, (size_t *)sizePtr))
#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
(sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tclGetUnicodeFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetUnicodeFromObj(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)))
#else
#define Tcl_GetStringFromObj(objPtr, sizePtr) \
(sizeof(*sizePtr) <= sizeof(int) ? (TclGetStringFromObj)(objPtr, (int *)sizePtr) : (Tcl_GetStringFromObj)(objPtr, (size_t *)sizePtr))
@@ -3849,6 +3852,8 @@ extern const TclStubs *tclStubsPtr;
(sizeof(*sizePtr) <= sizeof(int) ? (TclGetBytesFromObj)(NULL, objPtr, (int *)sizePtr) : Tcl_GetBytesFromObj(NULL, objPtr, (size_t *)sizePtr))
#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
(sizeof(*sizePtr) <= sizeof(int) ? (TclGetUnicodeFromObj)(objPtr, (int *)sizePtr) : Tcl_GetUnicodeFromObj(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)))
#endif
#ifdef TCL_MEM_DEBUG
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 4c3e53d..d7c3ab7 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -166,11 +166,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:
@@ -180,6 +181,7 @@ GetIndexFromObjList(
*----------------------------------------------------------------------
*/
+#undef Tcl_GetIndexFromObjStruct
int
Tcl_GetIndexFromObjStruct(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
@@ -192,8 +194,8 @@ Tcl_GetIndexFromObjStruct(
size_t 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. */
{
size_t index, idx, numAbbrev;
const char *key, *p1;
@@ -218,8 +220,8 @@ Tcl_GetIndexFromObjStruct(
if ((indexRep->tablePtr == tablePtr)
&& (indexRep->offset == offset)
&& (indexRep->index != TCL_INDEX_NONE)) {
- *indexPtr = (int)indexRep->index;
- return TCL_OK;
+ index = indexRep->index;
+ goto uncachedDone;
}
}
}
@@ -233,6 +235,9 @@ Tcl_GetIndexFromObjStruct(
index = TCL_INDEX_NONE;
numAbbrev = 0;
+ if (!*key && (flags & TCL_INDEX_NULL_OK)) {
+ goto uncachedDone;
+ }
/*
* Scan the table looking for one of:
* - An exact match (always preferred)
@@ -293,7 +298,25 @@ Tcl_GetIndexFromObjStruct(
indexRep->index = index;
}
- *indexPtr = (int)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:
@@ -319,7 +342,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) {
@@ -328,6 +351,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/tclScan.c b/generic/tclScan.c
index 4a5ef38..0a8e9ae 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -916,9 +916,10 @@ Tcl_ScanObjCmd(
}
if (flags & SCAN_LONGER) {
if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {
- wideValue = WIDE_MAX;
if (TclGetString(objPtr)[0] == '-') {
wideValue = WIDE_MIN;
+ } else {
+ wideValue = WIDE_MAX;
}
}
if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index c6550f4..f6156d1 100644
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -542,8 +542,7 @@ TclParseNumber(
int under = 0; /* Flag trailing '_' as error if true once
* number is accepted. */
-#define ALL_BITS UWIDE_MAX
-#define MOST_BITS (ALL_BITS >> 1)
+#define MOST_BITS (UWIDE_MAX >> 1)
/*
* Initialize bytes to start of the object's string rep if the caller
@@ -854,7 +853,7 @@ TclParseNumber(
acceptState = state;
acceptPoint = p;
acceptLen = len;
- /* FALLTHRU */
+ /* FALLTHRU */
case ZERO_B:
zerob:
if (c == '0') {
@@ -3785,15 +3784,13 @@ ShouldBankerRoundUp(
int r = mp_cmp_mag(twor, S);
switch (r) {
- case MP_LT:
- return 0;
case MP_EQ:
return isodd;
case MP_GT:
return 1;
+ default:
+ return 0;
}
- Tcl_Panic("in ShouldBankerRoundUp, trichotomy fails!");
- return 0;
}
/*
@@ -3831,15 +3828,13 @@ ShouldBankerRoundUpToNext(
r = mp_cmp_mag(&temp, S);
mp_clear(&temp);
switch(r) {
- case MP_LT:
- return 0;
case MP_EQ:
return isodd;
case MP_GT:
return 1;
+ default:
+ return 0;
}
- Tcl_Panic("in ShouldBankerRoundUpToNext, trichotomy fails!");
- return 0;
}
/*
diff --git a/generic/tclTest.c b/generic/tclTest.c
index b8f2d28..c0ab6b1 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -6288,7 +6288,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?");
@@ -6300,13 +6301,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);
diff --git a/tests/indexObj.test b/tests/indexObj.test
index f7a555a..a4060fa 100644
--- a/tests/indexObj.test
+++ b/tests/indexObj.test
@@ -140,6 +140,10 @@ test indexObj-6.6 {Tcl_GetIndexFromObjStruct with NULL input} -constraints testi
set x ""
testgetindexfromobjstruct $x 0
} -returnCodes error -result {ambiguous dummy "": must be a, c, or ee}
+test indexObj-6.7 {Tcl_GetIndexFromObjStruct} testindexobj {
+ set x ""
+ testgetindexfromobjstruct $x -1 4
+} "wrong # args: should be \"testgetindexfromobjstruct {} -1 4\""
test indexObj-7.1 {Tcl_ParseArgsObjv} testparseargs {
testparseargs
generated by cgit v0.12 at 2024-11-16 05:31:21 (GMT)