summaryrefslogtreecommitdiffstats
path: root/generic/tclIndexObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclIndexObj.c')
-rw-r--r--generic/tclIndexObj.c128
1 files changed, 19 insertions, 109 deletions
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 9f38638..5e1478d 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -79,70 +79,6 @@ typedef struct {
/*
*----------------------------------------------------------------------
*
- * 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. */
-{
- /*
- * 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).
- */
-
- if (!(flags & INDEX_TEMP_TABLE) && objPtr->typePtr == &indexType) {
- IndexRep *indexRep = objPtr->internalRep.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 */
-
-/*
- *----------------------------------------------------------------------
- *
* GetIndexFromObjList --
*
* This procedure looks up an object's value in a table of strings and
@@ -590,8 +526,8 @@ PrefixMatchObjCmd(
}
for (i = 1; i < (objc - 2); i++) {
- if (Tcl_GetIndexFromObj(interp, objv[i], matchOptions, "option", 0,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(interp, objv[i], matchOptions,
+ sizeof(char *), "option", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum matchOptions) index) {
@@ -660,7 +596,7 @@ PrefixMatchObjCmd(
}
Tcl_ListObjAppendElement(interp, errorPtr,
Tcl_NewStringObj("-code", 5));
- Tcl_ListObjAppendElement(interp, errorPtr, Tcl_NewIntObj(result));
+ Tcl_ListObjAppendElement(interp, errorPtr, Tcl_NewLongObj(result));
return Tcl_SetReturnOptions(interp, errorPtr);
}
@@ -876,33 +812,11 @@ Tcl_WrongNumArgs(
* NULL. */
{
Tcl_Obj *objPtr;
- int i, len, elemLen, flags;
+ size_t i, 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;
@@ -918,8 +832,8 @@ Tcl_WrongNumArgs(
*/
if (iPtr->ensembleRewrite.sourceObjs != NULL) {
- int toSkip = iPtr->ensembleRewrite.numInsertedObjs;
- int toPrint = iPtr->ensembleRewrite.numRemovedObjs;
+ size_t toSkip = iPtr->ensembleRewrite.numInsertedObjs;
+ size_t toPrint = iPtr->ensembleRewrite.numRemovedObjs;
Tcl_Obj *const *origObjv = iPtr->ensembleRewrite.sourceObjs;
/*
@@ -937,7 +851,7 @@ Tcl_WrongNumArgs(
* confusing error message...
*/
- if (objc < toSkip) {
+ if ((size_t)objc < toSkip) {
goto addNormalArgumentsToMessage;
}
@@ -964,12 +878,13 @@ Tcl_WrongNumArgs(
elementStr = EXPAND_OF(indexRep);
elemLen = strlen(elementStr);
} else {
- elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
+ elementStr = TclGetString(origObjv[i]);
+ elemLen = origObjv[i]->length;
}
flags = 0;
len = TclScanElement(elementStr, elemLen, &flags);
- if (MAY_QUOTE_WORD && len != elemLen) {
+ if (len != elemLen) {
char *quotedElementStr = TclStackAlloc(interp,
(unsigned)len + 1);
@@ -981,8 +896,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).
@@ -1000,7 +913,7 @@ Tcl_WrongNumArgs(
*/
addNormalArgumentsToMessage:
- for (i = 0; i < objc; i++) {
+ for (i = 0; i < (size_t)objc; i++) {
/*
* If the object is an index type use the index table which allows for
* the correct error message even if the subcommand was abbreviated.
@@ -1016,13 +929,14 @@ Tcl_WrongNumArgs(
* Quote the argument if it contains spaces (Bug 942757).
*/
- elementStr = TclGetStringFromObj(objv[i], &elemLen);
+ elementStr = TclGetString(objv[i]);
+ elemLen = objv[i]->length;
flags = 0;
len = TclScanElement(elementStr, elemLen, &flags);
- if (MAY_QUOTE_WORD && len != elemLen) {
+ if (len != elemLen) {
char *quotedElementStr = TclStackAlloc(interp,
- (unsigned) len + 1);
+ len + 1);
len = TclConvertElement(elementStr, elemLen,
quotedElementStr, flags);
@@ -1033,14 +947,12 @@ 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).
*/
- if (i<objc-1 || message!=NULL) {
+ if (i<(size_t)(objc-1) || message!=NULL) {
Tcl_AppendStringsToObj(objPtr, " ", NULL);
}
}
@@ -1057,8 +969,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
}
/*
@@ -1459,8 +1369,8 @@ TclGetCompletionCodeFromObj(
&& TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) {
return TCL_OK;
}
- if (Tcl_GetIndexFromObj(NULL, value, returnCodes, NULL, TCL_EXACT,
- codePtr) == TCL_OK) {
+ if (Tcl_GetIndexFromObjStruct(NULL, value, returnCodes,
+ sizeof(char *), NULL, TCL_EXACT, codePtr) == TCL_OK) {
return TCL_OK;
}
generated by cgit v0.12 at 2025-06-03 04:13:41 (GMT)