diff options
Diffstat (limited to 'generic/tclListObj.c')
-rw-r--r-- | generic/tclListObj.c | 196 |
1 files changed, 112 insertions, 84 deletions
diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 412a902..f330937 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -18,8 +18,8 @@ */ static List * AttemptNewList(Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); -static List * NewListIntRep(int objc, Tcl_Obj *CONST objv[], int p); + Tcl_Obj *const objv[]); +static List * NewListIntRep(int objc, Tcl_Obj *const objv[], int p); static void DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static void FreeListInternalRep(Tcl_Obj *listPtr); static int SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); @@ -38,7 +38,7 @@ static void UpdateStringOfList(Tcl_Obj *listPtr); * storage to avoid an auxiliary stack. */ -Tcl_ObjType tclListType = { +const Tcl_ObjType tclListType = { "list", /* name */ FreeListInternalRep, /* freeIntRepProc */ DupListInternalRep, /* dupIntRepProc */ @@ -72,7 +72,7 @@ Tcl_ObjType tclListType = { static List * NewListIntRep( int objc, - Tcl_Obj *CONST objv[], + Tcl_Obj *const objv[], int p) { List *listRepPtr; @@ -96,8 +96,7 @@ NewListIntRep( return NULL; } - listRepPtr = (List *) - attemptckalloc(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *))); + listRepPtr = attemptckalloc(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj*))); if (listRepPtr == NULL) { if (p) { Tcl_Panic("list creation failed: unable to alloc %u bytes", @@ -166,6 +165,7 @@ AttemptNewList( "list creation failed: unable to alloc %u bytes", (unsigned)(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *))))); } + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return listRepPtr; } @@ -202,7 +202,7 @@ AttemptNewList( Tcl_Obj * Tcl_NewListObj( int objc, /* Count of objects referenced by objv. */ - Tcl_Obj *CONST objv[]) /* An array of pointers to Tcl objects. */ + Tcl_Obj *const objv[]) /* An array of pointers to Tcl objects. */ { return Tcl_DbNewListObj(objc, objv, "unknown", 0); } @@ -212,7 +212,7 @@ Tcl_NewListObj( Tcl_Obj * Tcl_NewListObj( int objc, /* Count of objects referenced by objv. */ - Tcl_Obj *CONST objv[]) /* An array of pointers to Tcl objects. */ + Tcl_Obj *const objv[]) /* An array of pointers to Tcl objects. */ { List *listRepPtr; Tcl_Obj *listPtr; @@ -273,8 +273,8 @@ Tcl_NewListObj( Tcl_Obj * Tcl_DbNewListObj( int objc, /* Count of objects referenced by objv. */ - Tcl_Obj *CONST objv[], /* An array of pointers to Tcl objects. */ - CONST char *file, /* The name of the source file calling this + Tcl_Obj *const objv[], /* An array of pointers to Tcl objects. */ + const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ @@ -309,8 +309,8 @@ Tcl_DbNewListObj( Tcl_Obj * Tcl_DbNewListObj( int objc, /* Count of objects referenced by objv. */ - Tcl_Obj *CONST objv[], /* An array of pointers to Tcl objects. */ - CONST char *file, /* The name of the source file calling this + Tcl_Obj *const objv[], /* An array of pointers to Tcl objects. */ + const char *file, /* The name of the source file calling this * function; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ @@ -345,7 +345,7 @@ void Tcl_SetListObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ int objc, /* Count of objects referenced by objv. */ - Tcl_Obj *CONST objv[]) /* An array of pointers to Tcl objects. */ + Tcl_Obj *const objv[]) /* An array of pointers to Tcl objects. */ { List *listRepPtr; @@ -358,7 +358,6 @@ Tcl_SetListObj( */ TclFreeIntRep(objPtr); - objPtr->typePtr = NULL; Tcl_InvalidateStringRep(objPtr); /* @@ -636,12 +635,11 @@ Tcl_ListObjAppendElement( listRepPtr->elemCount = numElems; listRepPtr->refCount++; oldListRepPtr->refCount--; - listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr; } else if (newSize) { - listRepPtr = (List *) ckrealloc((char *)listRepPtr, (size_t)newSize); + listRepPtr = ckrealloc(listRepPtr, newSize); listRepPtr->maxElemCount = newMax; - listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr; } + listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr; /* * Add objPtr to the end of listPtr's array of element pointers. Increment @@ -817,7 +815,7 @@ Tcl_ListObjReplace( int first, /* Index of first element to replace. */ int count, /* Number of elements to replace. */ int objc, /* Number of objects to insert. */ - Tcl_Obj *CONST objv[]) /* An array of objc pointers to Tcl objects to + Tcl_Obj *const objv[]) /* An array of objc pointers to Tcl objects to * insert. */ { List *listRepPtr; @@ -925,7 +923,7 @@ Tcl_ListObjReplace( return TCL_ERROR; } - listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr; + listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr; listRepPtr->refCount++; elemPtrs = &listRepPtr->elements; @@ -979,7 +977,7 @@ Tcl_ListObjReplace( (size_t) numAfterLast * sizeof(Tcl_Obj *)); } - ckfree((char *) oldListRepPtr); + ckfree(oldListRepPtr); } } @@ -1128,8 +1126,8 @@ TclLindexFlat( Tcl_IncrRefCount(listPtr); for (i=0 ; i<indexCount && listPtr ; i++) { - int index, listLen; - Tcl_Obj **elemPtrs, *sublistCopy; + int index, listLen = 0; + Tcl_Obj **elemPtrs = NULL, *sublistCopy; /* * Here we make a private copy of the current sublist, so we avoid any @@ -1214,8 +1212,8 @@ TclLsetList( Tcl_Obj *indexArgPtr, /* Index or index-list arg to 'lset'. */ Tcl_Obj *valuePtr) /* Value arg to 'lset'. */ { - int indexCount; /* Number of indices in the index list. */ - Tcl_Obj **indices; /* Vector of indices in the index list. */ + int indexCount = 0; /* Number of indices in the index list. */ + Tcl_Obj **indices = NULL; /* Vector of indices in the index list. */ Tcl_Obj *retValuePtr; /* Pointer to the list to be returned. */ int index; /* Current index in the list - discarded. */ Tcl_Obj *indexListCopy; @@ -1266,8 +1264,8 @@ TclLsetList( * * Results: * Returns the new value of the list variable, or NULL if an error - * occurred. The returned object includes one reference count for - * the pointer returned. + * occurred. The returned object includes one reference count for the + * pointer returned. * * Side effects: * On entry, the reference count of the variable value does not reflect @@ -1309,12 +1307,12 @@ TclLsetFlat( /* Index args. */ Tcl_Obj *valuePtr) /* Value arg to 'lset'. */ { - int index, result; + int index, result, len; Tcl_Obj *subListPtr, *retValuePtr, *chainPtr; /* - * If there are no indices, simply return the new value. - * (Without indices, [lset] is a synonym for [set]. + * If there are no indices, simply return the new value. (Without + * indices, [lset] is a synonym for [set]. */ if (indexCount == 0) { @@ -1323,14 +1321,14 @@ TclLsetFlat( } /* - * If the list is shared, make a copy we can modify (copy-on-write). - * We use Tcl_DuplicateObj() instead of TclListObjCopy() for a few - * reasons: 1) we have not yet confirmed listPtr is actually a list; - * 2) We make a verbatim copy of any existing string rep, and when - * we combine that with the delayed invalidation of string reps of - * modified Tcl_Obj's implemented below, the outcome is that any - * error condition that causes this routine to return NULL, will - * leave the string rep of listPtr and all elements to be unchanged. + * If the list is shared, make a copy we can modify (copy-on-write). We + * use Tcl_DuplicateObj() instead of TclListObjCopy() for a few reasons: + * 1) we have not yet confirmed listPtr is actually a list; 2) We make a + * verbatim copy of any existing string rep, and when we combine that with + * the delayed invalidation of string reps of modified Tcl_Obj's + * implemented below, the outcome is that any error condition that causes + * this routine to return NULL, will leave the string rep of listPtr and + * all elements to be unchanged. */ subListPtr = Tcl_IsShared(listPtr) ? Tcl_DuplicateObj(listPtr) : listPtr; @@ -1344,8 +1342,8 @@ TclLsetFlat( chainPtr = NULL; /* - * Loop through all the index arguments, and for each one dive - * into the appropriate sublist. + * Loop through all the index arguments, and for each one dive into the + * appropriate sublist. */ do { @@ -1364,7 +1362,7 @@ TclLsetFlat( * WARNING: the macro TclGetIntForIndexM is not safe for * post-increments, avoid '*indexArray++' here. */ - + if (TclGetIntForIndexM(interp, *indexArray, elemCount - 1, &index) != TCL_OK) { /* ...the index we're trying to use isn't an index at all. */ @@ -1373,24 +1371,30 @@ TclLsetFlat( } indexArray++; - if (index < 0 || index >= elemCount) { + if (index < 0 || index > elemCount) { /* ...the index points outside the sublist. */ Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX", + NULL); break; } /* - * No error conditions. As long as we're not yet on the last - * index, determine the next sublist for the next pass through - * the loop, and take steps to make sure it is an unshared copy, - * as we intend to modify it. + * No error conditions. As long as we're not yet on the last index, + * determine the next sublist for the next pass through the loop, and + * take steps to make sure it is an unshared copy, as we intend to + * modify it. */ result = TCL_OK; if (--indexCount) { parentList = subListPtr; - subListPtr = elemPtrs[index]; + if (index == elemCount) { + subListPtr = Tcl_NewObj(); + } else { + subListPtr = elemPtrs[index]; + } if (Tcl_IsShared(subListPtr)) { subListPtr = Tcl_DuplicateObj(subListPtr); } @@ -1400,73 +1404,88 @@ TclLsetFlat( * we know to be unshared. This call will also deal with the * situation where parentList shares its intrep with other * Tcl_Obj's. Dealing with the shared intrep case can cause - * subListPtr to become shared again, so detect that case and - * make and store another copy. + * subListPtr to become shared again, so detect that case and make + * and store another copy. */ - TclListObjSetElement(NULL, parentList, index, subListPtr); + if (index == elemCount) { + Tcl_ListObjAppendElement(NULL, parentList, subListPtr); + } else { + TclListObjSetElement(NULL, parentList, index, subListPtr); + } if (Tcl_IsShared(subListPtr)) { subListPtr = Tcl_DuplicateObj(subListPtr); TclListObjSetElement(NULL, parentList, index, subListPtr); } /* - * The TclListObjSetElement() calls do not spoil the string - * rep of parentList, and that's fine for now, since all we've - * done so far is replace a list element with an unshared copy. - * The list value remains the same, so the string rep. is still - * valid, and unchanged, which is good because if this whole - * routine returns NULL, we'd like to leave no change to the - * value of the lset variable. Later on, when we set valuePtr - * in its proper place, then all containing lists will have - * their values changed, and will need their string reps spoiled. - * We maintain a list of all those Tcl_Obj's (via a little intrep - * surgery) so we can spoil them at that time. + * The TclListObjSetElement() calls do not spoil the string rep of + * parentList, and that's fine for now, since all we've done so + * far is replace a list element with an unshared copy. The list + * value remains the same, so the string rep. is still valid, and + * unchanged, which is good because if this whole routine returns + * NULL, we'd like to leave no change to the value of the lset + * variable. Later on, when we set valuePtr in its proper place, + * then all containing lists will have their values changed, and + * will need their string reps spoiled. We maintain a list of all + * those Tcl_Obj's (via a little intrep surgery) so we can spoil + * them at that time. */ - parentList->internalRep.twoPtrValue.ptr2 = (void *) chainPtr; + parentList->internalRep.twoPtrValue.ptr2 = chainPtr; chainPtr = parentList; } } while (indexCount > 0); /* - * Either we've detected and error condition, and exited the loop - * with result == TCL_ERROR, or we've successfully reached the last - * index, and we're ready to store valuePtr. In either case, we - * need to clean up our string spoiling list of Tcl_Obj's. + * Either we've detected and error condition, and exited the loop with + * result == TCL_ERROR, or we've successfully reached the last index, and + * we're ready to store valuePtr. In either case, we need to clean up our + * string spoiling list of Tcl_Obj's. */ while (chainPtr) { Tcl_Obj *objPtr = chainPtr; if (result == TCL_OK) { - /* - * We're going to store valuePtr, so spoil string reps - * of all containing lists. + * We're going to store valuePtr, so spoil string reps of all + * containing lists. */ Tcl_InvalidateStringRep(objPtr); } - /* Clear away our intrep surgery mess */ - chainPtr = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2; + /* + * Clear away our intrep surgery mess. + */ + + chainPtr = objPtr->internalRep.twoPtrValue.ptr2; objPtr->internalRep.twoPtrValue.ptr2 = NULL; } if (result != TCL_OK) { - /* - * Error return; message is already in interp. Clean up - * any excess memory. + /* + * Error return; message is already in interp. Clean up any excess + * memory. */ + if (retValuePtr != listPtr) { Tcl_DecrRefCount(retValuePtr); } return NULL; } - /* Store valuePtr in proper sublist and return */ - TclListObjSetElement(NULL, subListPtr, index, valuePtr); + /* + * Store valuePtr in proper sublist and return. + */ + + Tcl_ListObjLength(NULL, subListPtr, &len); + if (index == len) { + Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr); + } else { + TclListObjSetElement(NULL, subListPtr, index, valuePtr); + } Tcl_InvalidateStringRep(subListPtr); Tcl_IncrRefCount(retValuePtr); return retValuePtr; @@ -1530,6 +1549,8 @@ TclListObjSetElement( if (!length) { Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX", + NULL); return TCL_ERROR; } result = SetListFromAny(interp, listPtr); @@ -1550,6 +1571,8 @@ TclListObjSetElement( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("list index out of range", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX", + NULL); } return TCL_ERROR; } @@ -1575,7 +1598,7 @@ TclListObjSetElement( } listRepPtr->refCount++; listRepPtr->elemCount = elemCount; - listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr; + listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr; oldListRepPtr->refCount--; } @@ -1632,7 +1655,7 @@ FreeListInternalRep( for (i = 0; i < numElems; i++) { Tcl_DecrRefCount(elemPtrs[i]); } - ckfree((char *) listRepPtr); + ckfree(listRepPtr); } listPtr->internalRep.twoPtrValue.ptr1 = NULL; @@ -1691,7 +1714,8 @@ SetListFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { - char *string, *s; + const char *string; + char *s; const char *elemStart, *nextElem; int lenRemain, length, estCount, elemSize, i, j, result; const char *limit; /* Points just after string's last byte. */ @@ -1786,7 +1810,10 @@ SetListFromAny( elemPtr = elemPtrs[j]; Tcl_DecrRefCount(elemPtr); } - ckfree((char *) listRepPtr); + ckfree(listRepPtr); + if (interp != NULL) { + Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", NULL); + } return result; } if (elemStart >= limit) { @@ -1801,7 +1828,7 @@ SetListFromAny( * "elemSize" bytes starting at "elemStart". */ - s = ckalloc((unsigned) elemSize + 1); + s = ckalloc(elemSize + 1); if (literal) { memcpy(s, elemStart, (size_t) elemSize); s[elemSize] = 0; @@ -1860,7 +1887,8 @@ UpdateStringOfList( List *listRepPtr = ListRepPtr(listPtr); int numElems = listRepPtr->elemCount; register int i; - char *elem, *dst; + const char *elem; + char *dst; int length; Tcl_Obj **elemPtrs; @@ -1876,7 +1904,7 @@ UpdateStringOfList( if (numElems <= LOCAL_SIZE) { flagPtr = localFlags; } else { - flagPtr = (int *) ckalloc((unsigned) numElems * sizeof(int)); + flagPtr = ckalloc(numElems * sizeof(int)); } listPtr->length = 1; elemPtrs = &listRepPtr->elements; @@ -1897,7 +1925,7 @@ UpdateStringOfList( * Pass 2: copy into string rep buffer. */ - listPtr->bytes = ckalloc((unsigned) listPtr->length); + listPtr->bytes = ckalloc(listPtr->length); dst = listPtr->bytes; for (i = 0; i < numElems; i++) { elem = TclGetStringFromObj(elemPtrs[i], &length); @@ -1907,7 +1935,7 @@ UpdateStringOfList( dst++; } if (flagPtr != localFlags) { - ckfree((char *) flagPtr); + ckfree(flagPtr); } if (dst == listPtr->bytes) { *dst = 0; |