summaryrefslogtreecommitdiffstats
path: root/generic/tclListObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclListObj.c')
-rw-r--r--generic/tclListObj.c95
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;