diff options
Diffstat (limited to 'generic/tclListObj.c')
-rw-r--r-- | generic/tclListObj.c | 73 |
1 files changed, 47 insertions, 26 deletions
diff --git a/generic/tclListObj.c b/generic/tclListObj.c index b2a951e..0cfe27d 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; @@ -147,7 +147,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 +157,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 +225,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 +267,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 +303,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; @@ -781,7 +781,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; @@ -1092,8 +1092,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 +1178,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 +1273,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 +1328,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 +1337,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 +1354,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 +1372,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 +1427,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 +1438,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; @@ -1603,6 +1616,7 @@ FreeListInternalRep( listPtr->internalRep.twoPtrValue.ptr1 = NULL; listPtr->internalRep.twoPtrValue.ptr2 = NULL; + listPtr->typePtr = NULL; } /* @@ -1659,7 +1673,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 +1711,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 +1771,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; @@ -1770,6 +1787,9 @@ SetListFromAny( Tcl_DecrRefCount(elemPtr); } ckfree((char *) listRepPtr); + if (interp != NULL) { + Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", NULL); + } return result; } if (elemStart >= limit) { @@ -1810,7 +1830,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 +1866,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; |