diff options
Diffstat (limited to 'generic/tclIndexObj.c')
-rw-r--r-- | generic/tclIndexObj.c | 240 |
1 files changed, 123 insertions, 117 deletions
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 9eef11a..cb345e2 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -11,8 +11,6 @@ * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclIndexObj.c,v 1.59 2010/03/30 13:17:18 nijtmans Exp $ */ #include "tclInt.h" @@ -195,14 +193,14 @@ GetIndexFromObjList( * Build a string table from the list. */ - tablePtr = (const char **) ckalloc((objc + 1) * sizeof(char *)); + tablePtr = ckalloc((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((char *) tablePtr); + ckfree(tablePtr); *indexPtr = t; return TCL_OK; } @@ -219,8 +217,7 @@ GetIndexFromObjList( */ TclFreeIntRep(objPtr); - objPtr->typePtr = NULL; - ckfree((char *) tablePtr); + ckfree(tablePtr); return result; } @@ -342,7 +339,7 @@ Tcl_GetIndexFromObjStruct( indexRep = objPtr->internalRep.otherValuePtr; } else { TclFreeIntRep(objPtr); - indexRep = (IndexRep *) ckalloc(sizeof(IndexRep)); + indexRep = ckalloc(sizeof(IndexRep)); objPtr->internalRep.otherValuePtr = indexRep; objPtr->typePtr = &indexType; } @@ -359,29 +356,34 @@ Tcl_GetIndexFromObjStruct( * Produce a fancy error message. */ - int count; + int count = 0; TclNewObj(resultPtr); - Tcl_SetObjResult(interp, resultPtr); + entryPtr = tablePtr; + while ((*entryPtr != NULL) && !**entryPtr) { + entryPtr = NEXT_ENTRY(entryPtr, offset); + } Tcl_AppendStringsToObj(resultPtr, (numAbbrev>1 && !(flags & TCL_EXACT) ? "ambiguous " : "bad "), msg, " \"", key, NULL); - if (STRING_AT(tablePtr, offset, 0) == NULL) { + if (*entryPtr == NULL) { Tcl_AppendStringsToObj(resultPtr, "\": no valid options", NULL); } else { Tcl_AppendStringsToObj(resultPtr, "\": must be ", - STRING_AT(tablePtr, offset, 0), NULL); - for (entryPtr = NEXT_ENTRY(tablePtr, offset), count = 0; - *entryPtr != NULL; - entryPtr = NEXT_ENTRY(entryPtr, offset), count++) { + *entryPtr, NULL); + entryPtr = NEXT_ENTRY(entryPtr, offset); + while (*entryPtr != NULL) { if (*NEXT_ENTRY(entryPtr, offset) == NULL) { Tcl_AppendStringsToObj(resultPtr, (count > 0 ? "," : ""), " or ", *entryPtr, NULL); - } else { + } else if (**entryPtr) { Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, NULL); + count++; } + entryPtr = NEXT_ENTRY(entryPtr, offset); } } + Tcl_SetObjResult(interp, resultPtr); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL); } return TCL_ERROR; @@ -412,9 +414,11 @@ SetIndexFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ register Tcl_Obj *objPtr) /* The object to convert. */ { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + if (interp) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't convert value to index except via Tcl_GetIndexFromObj API", -1)); + } return TCL_ERROR; } @@ -445,7 +449,7 @@ UpdateStringOfIndex( register const char *indexStr = EXPAND_OF(indexRep); len = strlen(indexStr); - buf = (char *) ckalloc(len + 1); + buf = ckalloc(len + 1); memcpy(buf, indexStr, len+1); objPtr->bytes = buf; objPtr->length = len; @@ -475,7 +479,7 @@ DupIndex( Tcl_Obj *dupPtr) { IndexRep *srcIndexRep = srcPtr->internalRep.otherValuePtr; - IndexRep *dupIndexRep = (IndexRep *) ckalloc(sizeof(IndexRep)); + IndexRep *dupIndexRep = ckalloc(sizeof(IndexRep)); memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep)); dupPtr->internalRep.otherValuePtr = dupIndexRep; @@ -503,7 +507,7 @@ static void FreeIndex( Tcl_Obj *objPtr) { - ckfree((char *) objPtr->internalRep.otherValuePtr); + ckfree(objPtr->internalRep.otherValuePtr); objPtr->typePtr = NULL; } @@ -529,10 +533,10 @@ TclInitPrefixCmd( Tcl_Interp *interp) /* Current interpreter. */ { static const EnsembleImplMap prefixImplMap[] = { - {"all", PrefixAllObjCmd, NULL, NULL, NULL}, - {"longest", PrefixLongestObjCmd, NULL, NULL, NULL}, - {"match", PrefixMatchObjCmd, NULL, NULL, NULL}, - {NULL, NULL, NULL, NULL, NULL} + {"all", PrefixAllObjCmd, NULL, NULL, NULL, 0}, + {"longest", PrefixLongestObjCmd, NULL, NULL, NULL, 0}, + {"match", PrefixMatchObjCmd, NULL, NULL, NULL, 0}, + {NULL, NULL, NULL, NULL, NULL, 0} }; Tcl_Command prefixCmd; @@ -592,16 +596,20 @@ PrefixMatchObjCmd( flags |= TCL_EXACT; break; case PRFMATCH_MESSAGE: - if (i > (objc - 4)) { - Tcl_AppendResult(interp, "missing message", NULL); + if (i > objc-4) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing value for -message", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL); return TCL_ERROR; } i++; message = Tcl_GetString(objv[i]); break; case PRFMATCH_ERROR: - if (i > (objc - 4)) { - Tcl_AppendResult(interp, "missing error options", NULL); + if (i > objc-4) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing value for -error", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL); return TCL_ERROR; } i++; @@ -610,8 +618,10 @@ PrefixMatchObjCmd( return TCL_ERROR; } if ((errorLength % 2) != 0) { - Tcl_AppendResult(interp, "error options must have an even" - " number of elements", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "error options must have an even number of elements", + -1)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL); return TCL_ERROR; } errorPtr = objv[i]; @@ -951,12 +961,14 @@ Tcl_WrongNumArgs( } else { elementStr = TclGetStringFromObj(origObjv[i], &elemLen); } - len = Tcl_ScanCountedElement(elementStr, elemLen, &flags); + flags = 0; + len = TclScanElement(elementStr, elemLen, &flags); if (MAY_QUOTE_WORD && len != elemLen) { - char *quotedElementStr = TclStackAlloc(interp, (unsigned)len); + char *quotedElementStr = TclStackAlloc(interp, + (unsigned)len + 1); - len = Tcl_ConvertCountedElement(elementStr, elemLen, + len = TclConvertElement(elementStr, elemLen, quotedElementStr, flags); Tcl_AppendToObj(objPtr, quotedElementStr, len); TclStackFree(interp, quotedElementStr); @@ -1005,12 +1017,14 @@ Tcl_WrongNumArgs( */ elementStr = TclGetStringFromObj(objv[i], &elemLen); - len = Tcl_ScanCountedElement(elementStr, elemLen, &flags); + flags = 0; + len = TclScanElement(elementStr, elemLen, &flags); if (MAY_QUOTE_WORD && len != elemLen) { - char *quotedElementStr = TclStackAlloc(interp,(unsigned) len); + char *quotedElementStr = TclStackAlloc(interp, + (unsigned) len + 1); - len = Tcl_ConvertCountedElement(elementStr, elemLen, + len = TclConvertElement(elementStr, elemLen, quotedElementStr, flags); Tcl_AppendToObj(objPtr, quotedElementStr, len); TclStackFree(interp, quotedElementStr); @@ -1090,7 +1104,7 @@ Tcl_ParseArgsObjv( /* Pointer to the current entry in the table * of argument descriptions. */ const Tcl_ArgvInfo *matchPtr; - /* Descriptor that matches current argument. */ + /* Descriptor that matches current argument */ Tcl_Obj *curArg; /* Current argument */ const char *str = NULL; register char c; /* Second character of current arg (used for @@ -1103,17 +1117,19 @@ Tcl_ParseArgsObjv( * being processed, primarily for error * reporting. */ int objc; /* # arguments in objv still to process. */ - int length; /* Number of characters in current argument. */ + int length; /* Number of characters in current argument */ if (remObjv != NULL) { /* - * Then we should copy the name of the command (0th argument). + * Then we should copy the name of the command (0th argument). The + * upper bound on the number of elements is known, and (undocumented, + * but historically true) there should be a NULL argument after the + * last result. [Bug 3413857] */ nrem = 1; - leftovers = (Tcl_Obj **) ckalloc((nrem+1) * sizeof(Tcl_Obj *)); - leftovers[nrem-1] = objv[0]; - leftovers[nrem] = NULL; + leftovers = ckalloc((1 + *objcPtr) * sizeof(Tcl_Obj *)); + leftovers[0] = objv[0]; } else { nrem = 0; leftovers = NULL; @@ -1144,8 +1160,7 @@ Tcl_ParseArgsObjv( matchPtr = NULL; infoPtr = argTable; - for (; (infoPtr != NULL) && (infoPtr->type != TCL_ARGV_END); - infoPtr++) { + for (; infoPtr != NULL && infoPtr->type != TCL_ARGV_END ; infoPtr++) { if (infoPtr->keyStr == NULL) { continue; } @@ -1158,8 +1173,8 @@ Tcl_ParseArgsObjv( goto gotMatch; } if (matchPtr != NULL) { - Tcl_AppendResult(interp, "ambiguous option \"", str, "\"", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "ambiguous option \"%s\"", str)); goto error; } matchPtr = infoPtr; @@ -1171,21 +1186,13 @@ Tcl_ParseArgsObjv( */ if (remObjv == NULL) { - Tcl_AppendResult(interp, "unrecognized argument \"", str, - "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unrecognized argument \"%s\"", str)); goto error; } dstIndex++; /* This argument is now handled */ - nrem++; - - /* - * Allocate nrem (+1 extra for NULL terminator) pointers. - */ - - leftovers = (Tcl_Obj **) ckrealloc((void *) leftovers, - (nrem+1) * sizeof(Tcl_Obj *)); - leftovers[nrem-1] = curArg; + leftovers[nrem++] = curArg; continue; } @@ -1205,9 +1212,9 @@ Tcl_ParseArgsObjv( } if (Tcl_GetIntFromObj(interp, objv[srcIndex], (int *) infoPtr->dstPtr) == TCL_ERROR) { - Tcl_AppendResult(interp, "expected integer argument for \"", - infoPtr->keyStr, "\" but got \"", - Tcl_GetString(objv[srcIndex]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected integer argument for \"%s\" but got \"%s\"", + infoPtr->keyStr, Tcl_GetString(objv[srcIndex]))); goto error; } srcIndex++; @@ -1223,7 +1230,14 @@ Tcl_ParseArgsObjv( objc--; break; case TCL_ARGV_REST: - *((int *) infoPtr->dstPtr) = dstIndex; + /* + * Only store the point where we got to if it's not to be written + * to NULL, so that TCL_ARGV_AUTO_REST works. + */ + + if (infoPtr->dstPtr != NULL) { + *((int *) infoPtr->dstPtr) = dstIndex; + } goto argsDone; case TCL_ARGV_FLOAT: if (objc == 0) { @@ -1231,16 +1245,17 @@ Tcl_ParseArgsObjv( } if (Tcl_GetDoubleFromObj(interp, objv[srcIndex], (double *) infoPtr->dstPtr) == TCL_ERROR) { - Tcl_AppendResult(interp, "expected floating-point argument ", - "for \"", infoPtr->keyStr, "\" but got \"", - Tcl_GetString(objv[srcIndex]), "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected floating-point argument for \"%s\" but got \"%s\"", + infoPtr->keyStr, Tcl_GetString(objv[srcIndex]))); goto error; } srcIndex++; objc--; break; case TCL_ARGV_FUNC: { - Tcl_ArgvFuncProc *handlerProc; + Tcl_ArgvFuncProc *handlerProc = (Tcl_ArgvFuncProc *) + infoPtr->srcPtr; Tcl_Obj *argObj; if (objc == 0) { @@ -1248,7 +1263,6 @@ Tcl_ParseArgsObjv( } else { argObj = objv[srcIndex]; } - handlerProc = (Tcl_ArgvFuncProc *) infoPtr->srcPtr; if (handlerProc(infoPtr->clientData, argObj, infoPtr->dstPtr)) { srcIndex++; objc--; @@ -1256,9 +1270,9 @@ Tcl_ParseArgsObjv( break; } case TCL_ARGV_GENFUNC: { - Tcl_ArgvGenFuncProc *handlerProc; + Tcl_ArgvGenFuncProc *handlerProc = (Tcl_ArgvGenFuncProc *) + infoPtr->srcPtr; - handlerProc = (Tcl_ArgvGenFuncProc *) infoPtr->srcPtr; objc = handlerProc(infoPtr->clientData, interp, objc, &objv[srcIndex], infoPtr->dstPtr); if (objc < 0) { @@ -1269,20 +1283,18 @@ Tcl_ParseArgsObjv( case TCL_ARGV_HELP: PrintUsage(interp, argTable); goto error; - default: { - char buf[64 + TCL_INTEGER_SPACE]; - - sprintf(buf, "bad argument type %d in Tcl_ArgvInfo", - infoPtr->type); - Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); + default: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad argument type %d in Tcl_ArgvInfo", infoPtr->type)); goto error; } - } } /* * If we broke out of the loop because of an OPT_REST argument, copy the - * remaining arguments down. + * remaining arguments down. Note that there is always at least one + * argument left over - the command name - so we always have a result if + * our caller is willing to receive it. [Bug 3413857] */ argsDone: @@ -1295,20 +1307,12 @@ Tcl_ParseArgsObjv( } if (objc > 0) { - leftovers = (Tcl_Obj **) ckrealloc((void *) leftovers, - (nrem+objc+1) * sizeof(Tcl_Obj *)); - while (objc) { - leftovers[nrem] = objv[srcIndex]; - nrem++; - srcIndex++; - objc--; - } - } else if (leftovers != NULL) { - ckfree((char *) leftovers); + memcpy(leftovers+nrem, objv+srcIndex, objc*sizeof(Tcl_Obj *)); + nrem += objc; } leftovers[nrem] = NULL; - *objcPtr = nrem; - *remObjv = leftovers; + *objcPtr = nrem++; + *remObjv = ckrealloc(leftovers, nrem * sizeof(Tcl_Obj *)); return TCL_OK; /* @@ -1317,11 +1321,11 @@ Tcl_ParseArgsObjv( */ missingArg: - Tcl_AppendResult(interp, "\"", str, - "\" option requires an additional argument", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" option requires an additional argument", str)); error: if (leftovers != NULL) { - ckfree((char *) leftovers); + ckfree(leftovers); } return TCL_ERROR; } @@ -1354,8 +1358,9 @@ PrintUsage( register const Tcl_ArgvInfo *infoPtr; int width, numSpaces; #define NUM_SPACES 20 - static char spaces[] = " "; + static const char spaces[] = " "; char tmp[TCL_DOUBLE_SPACE]; + Tcl_Obj *msg; /* * First, compute the width of the widest option key, so that we can make @@ -1379,39 +1384,39 @@ PrintUsage( * Now add the option information, with pretty-printing. */ - Tcl_AppendResult(interp, "Command-specific options:", NULL); + msg = Tcl_NewStringObj("Command-specific options:", -1); for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) { if ((infoPtr->type == TCL_ARGV_HELP) && (infoPtr->keyStr == NULL)) { - Tcl_AppendResult(interp, "\n", infoPtr->helpStr, NULL); + Tcl_AppendPrintfToObj(msg, "\n%s", infoPtr->helpStr); continue; } - Tcl_AppendResult(interp, "\n ", infoPtr->keyStr, ":", NULL); + Tcl_AppendPrintfToObj(msg, "\n %s:", infoPtr->keyStr); numSpaces = width + 1 - strlen(infoPtr->keyStr); while (numSpaces > 0) { if (numSpaces >= NUM_SPACES) { - Tcl_AppendResult(interp, spaces, NULL); + Tcl_AppendToObj(msg, spaces, NUM_SPACES); } else { - Tcl_AppendResult(interp, spaces+NUM_SPACES-numSpaces, NULL); + Tcl_AppendToObj(msg, spaces, numSpaces); } numSpaces -= NUM_SPACES; } - Tcl_AppendResult(interp, infoPtr->helpStr, NULL); + Tcl_AppendToObj(msg, infoPtr->helpStr, -1); switch (infoPtr->type) { case TCL_ARGV_INT: - sprintf(tmp, "%d", *((int *) infoPtr->dstPtr)); - Tcl_AppendResult(interp, "\n\t\tDefault value: ", tmp, NULL); + Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %d", + *((int *) infoPtr->dstPtr)); break; case TCL_ARGV_FLOAT: + Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %g", + *((double *) infoPtr->dstPtr)); sprintf(tmp, "%g", *((double *) infoPtr->dstPtr)); - Tcl_AppendResult(interp, "\n\t\tDefault value: ", tmp, NULL); break; case TCL_ARGV_STRING: { - char *string; + char *string = *((char **) infoPtr->dstPtr); - string = *((char **) infoPtr->dstPtr); if (string != NULL) { - Tcl_AppendResult(interp, "\n\t\tDefault value: \"", string, - "\"", NULL); + Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: \"%s\"", + string); } break; } @@ -1419,6 +1424,7 @@ PrintUsage( break; } } + Tcl_SetObjResult(interp, msg); } /* @@ -1430,8 +1436,8 @@ PrintUsage( * * Results: * Returns TCL_ERROR if the value is an invalid completion code. - * Otherwise, returns TCL_OK, and writes the completion code to - * the pointer provided. + * Otherwise, returns TCL_OK, and writes the completion code to the + * pointer provided. * * Side effects: * None. @@ -1443,35 +1449,35 @@ int TclGetCompletionCodeFromObj( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *value, - int *code) /* Argument objects. */ + int *codePtr) /* Argument objects. */ { static const char *const returnCodes[] = { - "ok", "error", "return", "break", "continue", NULL + "ok", "error", "return", "break", "continue", NULL }; if ((value->typePtr != &indexType) - && (TCL_OK == TclGetIntFromObj(NULL, value, code))) { + && TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) { return TCL_OK; } - if (TCL_OK == Tcl_GetIndexFromObj( - NULL, value, returnCodes, NULL, TCL_EXACT, code)) { + if (Tcl_GetIndexFromObj(NULL, value, returnCodes, NULL, TCL_EXACT, + codePtr) == TCL_OK) { return TCL_OK; } + /* * Value is not a legal completion code. */ if (interp != NULL) { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad completion code \"", - TclGetString(value), - "\": must be ok, error, return, break, " - "continue, or an integer", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad completion code \"%s\": must be" + " ok, error, return, break, continue, or an integer", + TclGetString(value))); Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_CODE", NULL); } return TCL_ERROR; } - + /* * Local Variables: * mode: c |