diff options
Diffstat (limited to 'generic/tclListObj.c')
-rw-r--r-- | generic/tclListObj.c | 95 |
1 files changed, 57 insertions, 38 deletions
diff --git a/generic/tclListObj.c b/generic/tclListObj.c index b2a951e..46710d6 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -17,7 +17,7 @@ * Prototypes for functions defined later in this file: */ -static List * NewListIntRep(int objc, Tcl_Obj *CONST objv[]); +static List * NewListIntRep(int objc, Tcl_Obj *const objv[]); static void DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static void FreeListInternalRep(Tcl_Obj *listPtr); static int SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); @@ -36,7 +36,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 */ @@ -70,7 +70,7 @@ Tcl_ObjType tclListType = { static List * NewListIntRep( int objc, - Tcl_Obj *CONST objv[]) + Tcl_Obj *const objv[]) { List *listRepPtr; @@ -89,8 +89,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) { return NULL; } @@ -147,7 +146,7 @@ NewListIntRep( 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); } @@ -157,7 +156,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; @@ -225,8 +224,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. */ @@ -267,8 +266,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. */ @@ -303,7 +302,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; @@ -600,12 +599,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 @@ -781,7 +779,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; @@ -943,7 +941,7 @@ Tcl_ListObjReplace( (size_t) numAfterLast * sizeof(Tcl_Obj *)); } - ckfree((char *) oldListRepPtr); + ckfree(oldListRepPtr); } } @@ -1092,8 +1090,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 @@ -1178,8 +1176,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; @@ -1273,7 +1271,7 @@ TclLsetFlat( /* Index args. */ Tcl_Obj *valuePtr) /* Value arg to 'lset'. */ { - int index, result; + int index, result, len; Tcl_Obj *subListPtr, *retValuePtr, *chainPtr; /* @@ -1328,7 +1326,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. */ @@ -1337,7 +1335,7 @@ 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)); @@ -1354,7 +1352,11 @@ TclLsetFlat( 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); } @@ -1368,7 +1370,11 @@ TclLsetFlat( * 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); @@ -1419,9 +1425,9 @@ TclLsetFlat( } if (result != TCL_OK) { - /* + /* * Error return; message is already in interp. Clean up - * any excess memory. + * any excess memory. */ if (retValuePtr != listPtr) { Tcl_DecrRefCount(retValuePtr); @@ -1430,7 +1436,12 @@ TclLsetFlat( } /* Store valuePtr in proper sublist and return */ - TclListObjSetElement(NULL, subListPtr, index, valuePtr); + 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; @@ -1598,11 +1609,12 @@ FreeListInternalRep( objPtr = elemPtrs[i]; Tcl_DecrRefCount(objPtr); } - ckfree((char *) listRepPtr); + ckfree(listRepPtr); } listPtr->internalRep.twoPtrValue.ptr1 = NULL; listPtr->internalRep.twoPtrValue.ptr2 = NULL; + listPtr->typePtr = NULL; } /* @@ -1659,7 +1671,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, hasBrace, i, j, result; const char *limit; /* Points just after string's last byte. */ @@ -1696,6 +1709,7 @@ SetListFromAny( Tcl_SetResult(interp, "insufficient memory to allocate list working space", TCL_STATIC); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } listRepPtr->elemCount = 2 * size; @@ -1755,6 +1769,7 @@ SetListFromAny( if (!listRepPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "Not enough memory to allocate the list internal rep", -1)); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } elemPtrs = &listRepPtr->elements; @@ -1769,7 +1784,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) { @@ -1784,7 +1802,7 @@ SetListFromAny( * "elemSize" bytes starting at "elemStart". */ - s = ckalloc((unsigned) elemSize + 1); + s = ckalloc(elemSize + 1); if (hasBrace) { memcpy(s, elemStart, (size_t) elemSize); s[elemSize] = 0; @@ -1810,7 +1828,7 @@ SetListFromAny( commitRepresentation: listRepPtr->refCount++; TclFreeIntRep(objPtr); - objPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr; + objPtr->internalRep.twoPtrValue.ptr1 = listRepPtr; objPtr->internalRep.twoPtrValue.ptr2 = NULL; objPtr->typePtr = &tclListType; return TCL_OK; @@ -1846,7 +1864,8 @@ UpdateStringOfList( List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1; int numElems = listRepPtr->elemCount; register int i; - char *elem, *dst; + const char *elem; + char *dst; int length; Tcl_Obj **elemPtrs; @@ -1862,7 +1881,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; @@ -1883,7 +1902,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); @@ -1893,7 +1912,7 @@ UpdateStringOfList( dst++; } if (flagPtr != localFlags) { - ckfree((char *) flagPtr); + ckfree(flagPtr); } if (dst == listPtr->bytes) { *dst = 0; |