summaryrefslogtreecommitdiffstats
path: root/generic/tclIndexObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclIndexObj.c')
-rw-r--r--generic/tclIndexObj.c185
1 files changed, 45 insertions, 140 deletions
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 1f600c5..d7c3ab7 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -60,8 +60,8 @@ static const Tcl_ObjType indexType = {
typedef struct {
void *tablePtr; /* Pointer to the table of strings */
- int offset; /* Offset between table entries */
- int index; /* Selected index into table. */
+ size_t offset; /* Offset between table entries */
+ size_t index; /* Selected index into table. */
} IndexRep;
/*
@@ -73,76 +73,7 @@ typedef struct {
#define NEXT_ENTRY(table, offset) \
(&(STRING_AT(table, offset)))
#define EXPAND_OF(indexRep) \
- (((indexRep)->index >= 0) ? STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index) : "")
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetIndexFromObj --
- *
- * This function looks up an object's value in a table of strings and
- * returns the index of the matching string, if any.
- *
- * 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 flag 'bad option "foo": must be
- * ...'
- *
- * Side effects:
- * The result of the lookup is cached as the internal rep of objPtr, so
- * that repeated lookups can be done quickly.
- *
- *----------------------------------------------------------------------
- */
-
-#ifndef TCL_NO_DEPRECATED
-#undef Tcl_GetIndexFromObj
-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
- * value of objPtr; last entry must be NULL
- * and there must not be duplicate entries. */
- const char *msg, /* Identifying word to use in error
- * messages. */
- int flags, /* 0 or TCL_EXACT */
- int *indexPtr) /* Place to store resulting integer index. */
-{
- if (!(flags & TCL_INDEX_TEMP_TABLE)) {
-
- /*
- * See if there is a valid cached result from a previous lookup (doing the
- * check here saves the overhead of calling Tcl_GetIndexFromObjStruct in
- * the common case where the result is cached).
- */
-
- const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &indexType);
-
- if (irPtr) {
- IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
-
- /*
- * Here's hoping we don't get hit by unfortunate packing constraints
- * on odd platforms like a Cray PVP...
- */
-
- if (indexRep->tablePtr == (void *)tablePtr
- && indexRep->offset == sizeof(char *)) {
- *indexPtr = indexRep->index;
- return TCL_OK;
- }
- }
- }
- return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *),
- msg, flags, indexPtr);
-}
-#endif /* TCL_NO_DEPRECATED */
+ (((indexRep)->index != TCL_INDEX_NONE) ? STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index) : "")
/*
*----------------------------------------------------------------------
@@ -199,26 +130,26 @@ GetIndexFromObjList(
* Build a string table from the list.
*/
- tablePtr = (const char **)ckalloc((objc + 1) * sizeof(char *));
+ tablePtr = (const char **)Tcl_Alloc((objc + 1) * sizeof(char *));
for (t = 0; t < objc; t++) {
if (objv[t] == objPtr) {
/*
* An exact match is always chosen, so we can stop here.
*/
- ckfree(tablePtr);
+ Tcl_Free((void *)tablePtr);
*indexPtr = t;
return TCL_OK;
}
- tablePtr[t] = Tcl_GetString(objv[t]);
+ tablePtr[t] = TclGetString(objv[t]);
}
tablePtr[objc] = NULL;
result = Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr,
sizeof(char *), msg, flags | TCL_INDEX_TEMP_TABLE, indexPtr);
- ckfree(tablePtr);
+ Tcl_Free((void *)tablePtr);
return result;
}
@@ -260,13 +191,13 @@ Tcl_GetIndexFromObjStruct(
* offset, the third plus the offset again,
* etc. The last entry must be NULL and there
* must not be duplicate entries. */
- int offset, /* The number of bytes between entries */
+ size_t offset, /* The number of bytes between entries */
const char *msg, /* Identifying word to use in error
* messages. */
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;
+ size_t index, idx, numAbbrev;
const char *key, *p1;
const char *p2;
const char *const *entryPtr;
@@ -274,9 +205,9 @@ Tcl_GetIndexFromObjStruct(
IndexRep *indexRep;
const Tcl_ObjInternalRep *irPtr;
- /* Protect against invalid values, like -1 or 0. */
- if (offset < (int)sizeof(char *)) {
- offset = (int)sizeof(char *);
+ /* Protect against invalid values, like TCL_INDEX_NONE or 0. */
+ if (offset+1 <= sizeof(char *)) {
+ offset = sizeof(char *);
}
/*
* See if there is a valid cached result from a previous lookup.
@@ -288,7 +219,7 @@ Tcl_GetIndexFromObjStruct(
indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
if ((indexRep->tablePtr == tablePtr)
&& (indexRep->offset == offset)
- && (indexRep->index >= 0)) {
+ && (indexRep->index != TCL_INDEX_NONE)) {
index = indexRep->index;
goto uncachedDone;
}
@@ -301,7 +232,7 @@ Tcl_GetIndexFromObjStruct(
*/
key = objPtr ? TclGetString(objPtr) : "";
- index = -1;
+ index = TCL_INDEX_NONE;
numAbbrev = 0;
if (!*key && (flags & TCL_INDEX_NULL_OK)) {
@@ -351,14 +282,14 @@ Tcl_GetIndexFromObjStruct(
* operation.
*/
- if (objPtr && (index >= 0) && !(flags & TCL_INDEX_TEMP_TABLE)) {
+ if (objPtr && (index != TCL_INDEX_NONE) && !(flags & TCL_INDEX_TEMP_TABLE)) {
irPtr = TclFetchInternalRep(objPtr, &indexType);
if (irPtr) {
indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
} else {
Tcl_ObjInternalRep ir;
- indexRep = (IndexRep*)ckalloc(sizeof(IndexRep));
+ indexRep = (IndexRep*)Tcl_Alloc(sizeof(IndexRep));
ir.twoPtrValue.ptr1 = indexRep;
Tcl_StoreInternalRep(objPtr, &indexType, &ir);
}
@@ -481,7 +412,7 @@ DupIndex(
Tcl_Obj *dupPtr)
{
Tcl_ObjInternalRep ir;
- IndexRep *dupIndexRep = (IndexRep *)ckalloc(sizeof(IndexRep));
+ IndexRep *dupIndexRep = (IndexRep *)Tcl_Alloc(sizeof(IndexRep));
memcpy(dupIndexRep, TclFetchInternalRep(srcPtr, &indexType)->twoPtrValue.ptr1,
sizeof(IndexRep));
@@ -511,7 +442,7 @@ static void
FreeIndex(
Tcl_Obj *objPtr)
{
- ckfree(TclFetchInternalRep(objPtr, &indexType)->twoPtrValue.ptr1);
+ Tcl_Free(TclFetchInternalRep(objPtr, &indexType)->twoPtrValue.ptr1);
objPtr->typePtr = NULL;
}
@@ -607,7 +538,7 @@ PrefixMatchObjCmd(
return TCL_ERROR;
}
i++;
- message = Tcl_GetString(objv[i]);
+ message = TclGetString(objv[i]);
break;
case PRFMATCH_ERROR:
if (i > objc-4) {
@@ -697,7 +628,8 @@ PrefixAllObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int tableObjc, result, t, length, elemLength;
+ int tableObjc, result, t;
+ size_t length, elemLength;
const char *string, *elemString;
Tcl_Obj **tableObjv, *resultPtr;
@@ -711,10 +643,10 @@ PrefixAllObjCmd(
return result;
}
resultPtr = Tcl_NewListObj(0, NULL);
- string = TclGetStringFromObj(objv[2], &length);
+ string = Tcl_GetStringFromObj(objv[2], &length);
for (t = 0; t < tableObjc; t++) {
- elemString = TclGetStringFromObj(tableObjv[t], &elemLength);
+ elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength);
/*
* A prefix cannot match if it is longest.
@@ -754,7 +686,8 @@ PrefixLongestObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int tableObjc, result, i, t, length, elemLength, resultLength;
+ int tableObjc, result, t;
+ size_t i, length, elemLength, resultLength;
const char *string, *elemString, *resultString;
Tcl_Obj **tableObjv;
@@ -767,13 +700,13 @@ PrefixLongestObjCmd(
if (result != TCL_OK) {
return result;
}
- string = TclGetStringFromObj(objv[2], &length);
+ string = Tcl_GetStringFromObj(objv[2], &length);
resultString = NULL;
resultLength = 0;
for (t = 0; t < tableObjc; t++) {
- elemString = TclGetStringFromObj(tableObjv[t], &elemLength);
+ elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength);
/*
* First check if the prefix string matches the element. A prefix
@@ -877,34 +810,12 @@ Tcl_WrongNumArgs(
* NULL. */
{
Tcl_Obj *objPtr;
- int i, len, elemLen;
+ int i;
+ size_t len, elemLen;
char flags;
Interp *iPtr = (Interp *)interp;
const char *elementStr;
- /*
- * [incr Tcl] does something fairly horrific when generating error
- * messages for its ensembles; it passes the whole set of ensemble
- * arguments as a list in the first argument. This means that this code
- * causes a problem in iTcl if it attempts to correctly quote all
- * arguments, which would be the correct thing to do. We work around this
- * nasty behaviour for now, and hope that we can remove it all in the
- * future...
- */
-
-#ifndef AVOID_HACKS_FOR_ITCL
- int isFirst = 1; /* Special flag used to inhibit the treating
- * of the first word as a list element so the
- * hacky way Itcl generates error messages for
- * its ensembles will still work. [Bug
- * 1066837] */
-# define MAY_QUOTE_WORD (!isFirst)
-# define AFTER_FIRST_WORD (isFirst = 0)
-#else /* !AVOID_HACKS_FOR_ITCL */
-# define MAY_QUOTE_WORD 1
-# define AFTER_FIRST_WORD (void) 0
-#endif /* AVOID_HACKS_FOR_ITCL */
-
TclNewObj(objPtr);
if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) {
iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
@@ -943,7 +854,7 @@ Tcl_WrongNumArgs(
objc -= toSkip;
/*
- * We assume no object is of index type.
+ * Assume no object is of index type.
*/
for (i=0 ; i<toPrint ; i++) {
@@ -958,12 +869,12 @@ Tcl_WrongNumArgs(
elementStr = EXPAND_OF(indexRep);
elemLen = strlen(elementStr);
} else {
- elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
+ elementStr = Tcl_GetStringFromObj(origObjv[i], &elemLen);
}
flags = 0;
len = TclScanElement(elementStr, elemLen, &flags);
- if (MAY_QUOTE_WORD && len != elemLen) {
+ if (len != elemLen) {
char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1);
len = TclConvertElement(elementStr, elemLen,
@@ -974,8 +885,6 @@ Tcl_WrongNumArgs(
Tcl_AppendToObj(objPtr, elementStr, elemLen);
}
- AFTER_FIRST_WORD;
-
/*
* Add a space if the word is not the last one (which has a
* moderately complex condition here).
@@ -995,7 +904,7 @@ Tcl_WrongNumArgs(
addNormalArgumentsToMessage:
for (i = 0; i < objc; i++) {
/*
- * If the object is an index type use the index table which allows for
+ * If the object is an index type, use the index table which allows for
* the correct error message even if the subcommand was abbreviated.
* Otherwise, just use the string rep.
*/
@@ -1010,11 +919,11 @@ Tcl_WrongNumArgs(
* Quote the argument if it contains spaces (Bug 942757).
*/
- elementStr = TclGetStringFromObj(objv[i], &elemLen);
+ elementStr = Tcl_GetStringFromObj(objv[i], &elemLen);
flags = 0;
len = TclScanElement(elementStr, elemLen, &flags);
- if (MAY_QUOTE_WORD && len != elemLen) {
+ if (len != elemLen) {
char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1);
len = TclConvertElement(elementStr, elemLen,
@@ -1026,8 +935,6 @@ Tcl_WrongNumArgs(
}
}
- AFTER_FIRST_WORD;
-
/*
* Append a space character (" ") if there is more text to follow
* (either another element from objv, or the message string).
@@ -1050,8 +957,6 @@ Tcl_WrongNumArgs(
Tcl_AppendStringsToObj(objPtr, "\"", NULL);
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
Tcl_SetObjResult(interp, objPtr);
-#undef MAY_QUOTE_WORD
-#undef AFTER_FIRST_WORD
}
/*
@@ -1110,7 +1015,7 @@ Tcl_ParseArgsObjv(
* being processed, primarily for error
* reporting. */
int objc; /* # arguments in objv still to process. */
- int length; /* Number of characters in current argument */
+ size_t length; /* Number of characters in current argument */
if (remObjv != NULL) {
/*
@@ -1121,7 +1026,7 @@ Tcl_ParseArgsObjv(
*/
nrem = 1;
- leftovers = (Tcl_Obj **)ckalloc((1 + *objcPtr) * sizeof(Tcl_Obj *));
+ leftovers = (Tcl_Obj **)Tcl_Alloc((1 + *objcPtr) * sizeof(Tcl_Obj *));
leftovers[0] = objv[0];
} else {
nrem = 0;
@@ -1139,7 +1044,7 @@ Tcl_ParseArgsObjv(
curArg = objv[srcIndex];
srcIndex++;
objc--;
- str = TclGetStringFromObj(curArg, &length);
+ str = Tcl_GetStringFromObj(curArg, &length);
if (length > 0) {
c = str[1];
} else {
@@ -1207,7 +1112,7 @@ Tcl_ParseArgsObjv(
(int *) infoPtr->dstPtr) == TCL_ERROR) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer argument for \"%s\" but got \"%s\"",
- infoPtr->keyStr, Tcl_GetString(objv[srcIndex])));
+ infoPtr->keyStr, TclGetString(objv[srcIndex])));
goto error;
}
srcIndex++;
@@ -1218,7 +1123,7 @@ Tcl_ParseArgsObjv(
goto missingArg;
}
*((const char **) infoPtr->dstPtr) =
- Tcl_GetString(objv[srcIndex]);
+ TclGetString(objv[srcIndex]);
srcIndex++;
objc--;
break;
@@ -1240,7 +1145,7 @@ Tcl_ParseArgsObjv(
(double *) infoPtr->dstPtr) == TCL_ERROR) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected floating-point argument for \"%s\" but got \"%s\"",
- infoPtr->keyStr, Tcl_GetString(objv[srcIndex])));
+ infoPtr->keyStr, TclGetString(objv[srcIndex])));
goto error;
}
srcIndex++;
@@ -1305,7 +1210,7 @@ Tcl_ParseArgsObjv(
}
leftovers[nrem] = NULL;
*objcPtr = nrem++;
- *remObjv = (Tcl_Obj **)ckrealloc(leftovers, nrem * sizeof(Tcl_Obj *));
+ *remObjv = (Tcl_Obj **)Tcl_Realloc(leftovers, nrem * sizeof(Tcl_Obj *));
return TCL_OK;
/*
@@ -1318,7 +1223,7 @@ Tcl_ParseArgsObjv(
"\"%s\" option requires an additional argument", str));
error:
if (leftovers != NULL) {
- ckfree(leftovers);
+ Tcl_Free(leftovers);
}
return TCL_ERROR;
}
@@ -1361,13 +1266,13 @@ PrintUsage(
width = 4;
for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) {
- int length;
+ size_t length;
if (infoPtr->keyStr == NULL) {
continue;
}
length = strlen(infoPtr->keyStr);
- if (length > width) {
+ if (length > (size_t)width) {
width = length;
}
}
generated by cgit v0.12 at 2024-11-16 12:25:09 (GMT)