diff options
| -rw-r--r-- | ChangeLog | 14 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 9 | ||||
| -rw-r--r-- | generic/tclIndexObj.c | 44 | ||||
| -rw-r--r-- | generic/tclListObj.c | 106 | ||||
| -rw-r--r-- | generic/tclVar.c | 7 |
5 files changed, 108 insertions, 72 deletions
@@ -1,10 +1,18 @@ +2011-08-16 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclListObj.c (TclLindexList, TclLsetFlat): Silence warnings + about (unreachable) cases of uninitialized variables. + * generic/tclCmdIL.c (SelectObjFromSublist): Improve the generation of + * generic/tclIndexObj.c (Tcl_ParseArgsObjv): messages through the use + * generic/tclVar.c (ArrayStartSearchCmd): of Tcl_ObjPrintf. + 2011-08-15 Don Porter <dgp@users.sourceforge.net> - * generic/tclBasic.c: [Bug 3390272] Leak of [info script] value. + * generic/tclBasic.c: [Bug 3390272]: Leak of [info script] value. 2011-08-15 Jan Nijtmans <nijtmans@users.sf.net> - * generic/tclPosixStr.c: [Bug 3388350] mingw64 compiler warnings + * generic/tclPosixStr.c: [Bug 3388350]: mingw64 compiler warnings * win/tclWinPort.h: * win/configure.in * win/configure @@ -16,7 +24,7 @@ 2011-08-12 Don Porter <dgp@users.sourceforge.net> - * generic/tclPathObj.c: [Bug 3389764] Eliminate possibility that dup + * generic/tclPathObj.c: [Bug 3389764]: Eliminate possibility that dup of a "path" value can create reference cycle. 2011-08-12 Donal K. Fellows <dkf@users.sf.net> diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 64348ad..95532d3 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -4446,12 +4446,9 @@ SelectObjFromSublist( return NULL; } if (currentObj == NULL) { - char buffer[TCL_INTEGER_SPACE]; - - TclFormatInt(buffer, index); - Tcl_AppendResult(infoPtr->interp, "element ", buffer, - " missing from sublist \"", TclGetString(objPtr), "\"", - NULL); + Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf( + "element %d missing from sublist \"%s\"", + index, TclGetString(objPtr))); Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT", "INDEXFAILED", NULL); infoPtr->resultCode = TCL_ERROR; diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 76c2dea..6f378a4 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -359,7 +359,6 @@ Tcl_GetIndexFromObjStruct( int count; TclNewObj(resultPtr); - Tcl_SetObjResult(interp, resultPtr); Tcl_AppendStringsToObj(resultPtr, (numAbbrev>1 && !(flags & TCL_EXACT) ? "ambiguous " : "bad "), msg, " \"", key, NULL); @@ -379,6 +378,7 @@ Tcl_GetIndexFromObjStruct( } } } + Tcl_SetObjResult(interp, resultPtr); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL); } return TCL_ERROR; @@ -410,7 +410,7 @@ SetIndexFromAny( register Tcl_Obj *objPtr) /* The object to convert. */ { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't convert value to index except via Tcl_GetIndexFromObj API", -1)); } @@ -593,14 +593,16 @@ PrefixMatchObjCmd( case PRFMATCH_MESSAGE: if (i > (objc - 4)) { Tcl_AppendResult(interp, "missing message", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL); return TCL_ERROR; } i++; message = Tcl_GetString(objv[i]); break; case PRFMATCH_ERROR: - if (i > (objc - 4)) { + if (i > objc-4) { Tcl_AppendResult(interp, "missing error options", NULL); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL); return TCL_ERROR; } i++; @@ -611,6 +613,7 @@ PrefixMatchObjCmd( if ((errorLength % 2) != 0) { Tcl_AppendResult(interp, "error options must have an even" " number of elements", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL); return TCL_ERROR; } errorPtr = objv[i]; @@ -1093,7 +1096,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 @@ -1106,7 +1109,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. */ + int length; /* Number of characters in current argument */ if (remObjv != NULL) { /* @@ -1147,8 +1150,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; } @@ -1242,7 +1244,8 @@ Tcl_ParseArgsObjv( objc--; break; case TCL_ARGV_FUNC: { - Tcl_ArgvFuncProc *handlerProc; + Tcl_ArgvFuncProc *handlerProc = (Tcl_ArgvFuncProc *) + infoPtr->srcPtr; Tcl_Obj *argObj; if (objc == 0) { @@ -1250,7 +1253,6 @@ Tcl_ParseArgsObjv( } else { argObj = objv[srcIndex]; } - handlerProc = (Tcl_ArgvFuncProc *) infoPtr->srcPtr; if (handlerProc(infoPtr->clientData, argObj, infoPtr->dstPtr)) { srcIndex++; objc--; @@ -1258,9 +1260,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) { @@ -1271,15 +1273,11 @@ 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; } - } } /* @@ -1444,18 +1442,18 @@ int TclGetCompletionCodeFromObj( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *value, - int *code) /* Argument objects. */ + int *code) /* 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))) { return TCL_OK; } - if (TCL_OK == Tcl_GetIndexFromObj( - NULL, value, returnCodes, NULL, TCL_EXACT, code)) { + if (TCL_OK == Tcl_GetIndexFromObj(NULL, value, returnCodes, NULL, + TCL_EXACT, code)) { return TCL_OK; } /* @@ -1472,7 +1470,7 @@ TclGetCompletionCodeFromObj( } return TCL_ERROR; } - + /* * Local Variables: * mode: c diff --git a/generic/tclListObj.c b/generic/tclListObj.c index ac87628..3668b45 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -49,7 +49,6 @@ const Tcl_ObjType tclListType = { #ifndef TCL_MIN_ELEMENT_GROWTH #define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *) #endif - /* *---------------------------------------------------------------------- @@ -518,7 +517,10 @@ Tcl_ListObjAppendList( Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList"); } - /* Pull the elements to append from elemListPtr */ + /* + * Pull the elements to append from elemListPtr. + */ + if (TCL_OK != TclListObjGetElements(interp, elemListPtr, &objc, &objv)) { return TCL_ERROR; } @@ -600,7 +602,10 @@ Tcl_ListObjAppendElement( } if (needGrow && !isShared) { - /* Need to grow + unshared intrep => try to realloc */ + /* + * Need to grow + unshared intrep => try to realloc + */ + attempt = 2 * numRequired; if (attempt <= LIST_MAX) { newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt)); @@ -626,10 +631,10 @@ Tcl_ListObjAppendElement( Tcl_Obj **dst, **src = &listRepPtr->elements; /* - * Either we have a shared intrep and we must copy to write, - * or we need to grow and realloc attempts failed. - * Attempt intrep copy. + * Either we have a shared intrep and we must copy to write, or we + * need to grow and realloc attempts failed. Attempt intrep copy. */ + attempt = 2 * numRequired; newPtr = AttemptNewList(NULL, attempt, NULL); if (newPtr == NULL) { @@ -644,7 +649,10 @@ Tcl_ListObjAppendElement( newPtr = AttemptNewList(interp, attempt, NULL); } if (newPtr == NULL) { - /* All growth attempts failed; throw the error */ + /* + * All growth attempts failed; throw the error. + */ + return TCL_ERROR; } @@ -655,8 +663,8 @@ Tcl_ListObjAppendElement( if (isShared) { /* - * The original intrep must remain undisturbed. - * Copy into the new one and bump refcounts + * The original intrep must remain undisturbed. Copy into the new + * one and bump refcounts */ while (numElems--) { *dst = *src++; @@ -664,9 +672,11 @@ Tcl_ListObjAppendElement( } listRepPtr->refCount--; } else { - /* Old intrep to be freed, re-use refCounts */ - memcpy(dst, src, (size_t) numElems * sizeof(Tcl_Obj *)); + /* + * Old intrep to be freed, re-use refCounts. + */ + memcpy(dst, src, (size_t) numElems * sizeof(Tcl_Obj *)); ckfree(listRepPtr); } listRepPtr = newPtr; @@ -854,11 +864,10 @@ Tcl_ListObjReplace( } if (listPtr->typePtr != &tclListType) { if (listPtr->bytes == tclEmptyStringRep) { - if (objc) { - Tcl_SetListObj(listPtr, objc, NULL); - } else { + if (!objc) { return TCL_OK; } + Tcl_SetListObj(listPtr, objc, NULL); } else { int result = SetListFromAny(interp, listPtr); @@ -891,8 +900,9 @@ Tcl_ListObjReplace( } else if (numElems < first+count || first+count < 0) { /* * The 'first+count < 0' condition here guards agains integer - * overflow in determining 'first+count' + * overflow in determining 'first+count'. */ + count = numElems - first; } @@ -1075,8 +1085,6 @@ TclLindexList( { int index; /* Index into the list. */ - Tcl_Obj **indices; /* Array of list indices. */ - int indexCount; /* Size of the array of list indices. */ Tcl_Obj *indexListCopy; /* @@ -1116,8 +1124,19 @@ TclLindexList( return TclLindexFlat(interp, listPtr, 1, &argPtr); } - TclListObjGetElements(NULL, indexListCopy, &indexCount, &indices); - listPtr = TclLindexFlat(interp, listPtr, indexCount, indices); + if (indexListCopy->typePtr == &tclListType) { + List *listRepPtr = ListRepPtr(indexListCopy); + + listPtr = TclLindexFlat(interp, listPtr, listRepPtr->elemCount, + &listRepPtr->elements); + } else { + int indexCount = -1; /* Size of the array of list indices. */ + Tcl_Obj **indices = NULL; + /* Array of list indices. */ + + Tcl_ListObjGetElements(NULL, indexListCopy, &indexCount, &indices); + listPtr = TclLindexFlat(interp, listPtr, indexCount, indices); + } Tcl_DecrRefCount(indexListCopy); return listPtr; } @@ -1375,6 +1394,7 @@ TclLsetFlat( retValuePtr = subListPtr; chainPtr = NULL; + result = TCL_OK; /* * Loop through all the index arguments, and for each one dive into the @@ -1385,11 +1405,14 @@ TclLsetFlat( int elemCount; Tcl_Obj *parentList, **elemPtrs; - /* Check for the possible error conditions... */ - result = TCL_ERROR; + /* + * Check for the possible error conditions... + */ + if (TclListObjGetElements(interp, subListPtr, &elemCount, &elemPtrs) != TCL_OK) { /* ...the sublist we're indexing into isn't a list at all. */ + result = TCL_ERROR; break; } @@ -1401,6 +1424,7 @@ TclLsetFlat( if (TclGetIntForIndexM(interp, *indexArray, elemCount - 1, &index) != TCL_OK) { /* ...the index we're trying to use isn't an index at all. */ + result = TCL_ERROR; indexArray++; break; } @@ -1411,9 +1435,10 @@ TclLsetFlat( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", + "BADINDEX", NULL); } - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX", - NULL); + result = TCL_ERROR; break; } @@ -1424,7 +1449,6 @@ TclLsetFlat( * modify it. */ - result = TCL_OK; if (--indexCount) { parentList = subListPtr; if (index == elemCount) { @@ -1514,10 +1538,13 @@ TclLsetFlat( } /* - * Store valuePtr in proper sublist and return. + * Store valuePtr in proper sublist and return. The -1 is to avoid a + * compiler warning (not a problem because we checked that we have a + * proper list - or something convertible to one - above). */ - Tcl_ListObjLength(NULL, subListPtr, &len); + len = -1; + TclListObjLength(NULL, subListPtr, &len); if (index == len) { Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr); } else { @@ -1586,9 +1613,9 @@ TclListObjSetElement( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", + "BADINDEX", NULL); } - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX", - NULL); return TCL_ERROR; } result = SetListFromAny(interp, listPtr); @@ -1811,19 +1838,23 @@ SetListFromAny( */ estCount = TclMaxListLength(nextElem, length, &limit); - estCount += (estCount == 0); /* Smallest List struct holds 1 element. */ + estCount += (estCount == 0); /* Smallest list struct holds 1 + * element. */ listRepPtr = AttemptNewList(interp, estCount, NULL); if (listRepPtr == NULL) { return TCL_ERROR; } elemPtrs = &listRepPtr->elements; - /* Each iteration, parse and store a list element */ + /* + * Each iteration, parse and store a list element. + */ + while (nextElem < limit) { const char *elemStart; int elemSize, literal; - if (TCL_OK != TclFindElement(interp, nextElem, (limit - nextElem), + if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem, &elemStart, &nextElem, &elemSize, &literal)) { while (--elemPtrs >= &listRepPtr->elements) { Tcl_DecrRefCount(*elemPtrs); @@ -1904,7 +1935,9 @@ UpdateStringOfList( listRepPtr->canonicalFlag = 1; - /* Handle empty list case first, so rest of the routine is simpler */ + /* + * Handle empty list case first, so rest of the routine is simpler. + */ if (numElems == 0) { listPtr->bytes = tclEmptyStringRep; @@ -1919,12 +1952,15 @@ UpdateStringOfList( if (numElems <= LOCAL_SIZE) { flagPtr = localFlags; } else { - /* We know numElems <= LIST_MAX, so this is safe. */ + /* + * We know numElems <= LIST_MAX, so this is safe. + */ + flagPtr = ckalloc(numElems * sizeof(int)); } elemPtrs = &listRepPtr->elements; for (i = 0; i < numElems; i++) { - flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 ); + flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0); elem = TclGetStringFromObj(elemPtrs[i], &length); bytesNeeded += TclScanElement(elem, length, flagPtr+i); if (bytesNeeded < 0) { @@ -1944,7 +1980,7 @@ UpdateStringOfList( listPtr->bytes = ckalloc(bytesNeeded); dst = listPtr->bytes; for (i = 0; i < numElems; i++) { - flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 ); + flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0); elem = TclGetStringFromObj(elemPtrs[i], &length); dst += TclConvertElement(elem, length, dst, flagPtr[i]); *dst++ = ' '; diff --git a/generic/tclVar.c b/generic/tclVar.c index 62bf1c4..4df5d43 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -3077,21 +3077,18 @@ ArrayStartSearchCmd( hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew); if (isNew) { searchPtr->id = 1; - Tcl_AppendResult(interp, "s-1-", varName, NULL); varPtr->flags |= VAR_SEARCH_ACTIVE; searchPtr->nextPtr = NULL; } else { - char string[TCL_INTEGER_SPACE]; - searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1; - TclFormatInt(string, searchPtr->id); - Tcl_AppendResult(interp, "s-", string, "-", varName, NULL); searchPtr->nextPtr = Tcl_GetHashValue(hPtr); } searchPtr->varPtr = varPtr; searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr, &searchPtr->search); Tcl_SetHashValue(hPtr, searchPtr); + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("s-%d-%s", searchPtr->id, varName)); return TCL_OK; } |