summaryrefslogtreecommitdiffstats
path: root/generic/tclListObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclListObj.c')
-rw-r--r--generic/tclListObj.c205
1 files changed, 118 insertions, 87 deletions
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 9544337..8a0f89a 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;
@@ -182,7 +181,7 @@ Tcl_NewListObj(
*/
Tcl_InvalidateStringRep(listPtr);
- listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+ listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
listPtr->internalRep.twoPtrValue.ptr2 = NULL;
listPtr->typePtr = &tclListType;
listRepPtr->refCount++;
@@ -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. */
@@ -254,7 +253,7 @@ Tcl_DbNewListObj(
*/
Tcl_InvalidateStringRep(listPtr);
- listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+ listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
listPtr->internalRep.twoPtrValue.ptr2 = NULL;
listPtr->typePtr = &tclListType;
listRepPtr->refCount++;
@@ -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;
@@ -330,7 +329,7 @@ Tcl_SetListObj(
if (!listRepPtr) {
Tcl_Panic("Cannot allocate enough memory for Tcl_SetListObj");
}
- objPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = &tclListType;
listRepPtr->refCount++;
@@ -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;
@@ -889,7 +887,7 @@ Tcl_ListObjReplace(
Tcl_Panic("Not enough memory to allocate list");
}
- listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+ listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
listRepPtr->refCount++;
elemPtrs = &listRepPtr->elements;
@@ -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;
@@ -1230,8 +1228,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
@@ -1273,12 +1271,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) {
@@ -1287,14 +1285,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;
@@ -1308,8 +1306,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 {
@@ -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,24 +1335,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);
}
@@ -1364,73 +1368,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;
@@ -1494,6 +1513,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);
@@ -1514,6 +1535,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;
}
@@ -1539,7 +1562,7 @@ TclListObjSetElement(
}
listRepPtr->refCount++;
listRepPtr->elemCount = elemCount;
- listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+ listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
oldListRepPtr->refCount--;
}
@@ -1598,11 +1621,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;
}
/*
@@ -1630,7 +1654,7 @@ DupListInternalRep(
List *listRepPtr = ListRepPtr(srcPtr);
listRepPtr->refCount++;
- copyPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+ copyPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
copyPtr->typePtr = &tclListType;
}
@@ -1659,7 +1683,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 +1721,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 +1781,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 +1796,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 +1814,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 +1840,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 +1876,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;
@@ -1862,7 +1893,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 +1914,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 +1924,7 @@ UpdateStringOfList(
dst++;
}
if (flagPtr != localFlags) {
- ckfree((char *) flagPtr);
+ ckfree(flagPtr);
}
if (dst == listPtr->bytes) {
*dst = 0;
generated by cgit v0.12 at 2024-11-02 18:59:51 (GMT)