summaryrefslogtreecommitdiffstats
path: root/generic/tclListObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclListObj.c')
-rw-r--r--generic/tclListObj.c195
1 files changed, 112 insertions, 83 deletions
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 3b9dce6..7d0743d 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;
@@ -636,12 +636,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 +816,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 +924,7 @@ Tcl_ListObjReplace(
return TCL_ERROR;
}
- listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+ listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
listRepPtr->refCount++;
elemPtrs = &listRepPtr->elements;
@@ -979,7 +978,7 @@ Tcl_ListObjReplace(
(size_t) numAfterLast * sizeof(Tcl_Obj *));
}
- ckfree((char *) oldListRepPtr);
+ ckfree(oldListRepPtr);
}
}
@@ -1128,8 +1127,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 +1213,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 +1265,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 +1308,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 +1322,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 +1343,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 +1363,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 +1372,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 +1405,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 +1550,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 +1572,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 +1599,7 @@ TclListObjSetElement(
}
listRepPtr->refCount++;
listRepPtr->elemCount = elemCount;
- listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
+ listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
oldListRepPtr->refCount--;
}
@@ -1632,7 +1656,7 @@ FreeListInternalRep(
for (i = 0; i < numElems; i++) {
Tcl_DecrRefCount(elemPtrs[i]);
}
- ckfree((char *) listRepPtr);
+ ckfree(listRepPtr);
}
listPtr->internalRep.twoPtrValue.ptr1 = NULL;
@@ -1691,7 +1715,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. */
@@ -1796,7 +1821,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) {
@@ -1811,7 +1839,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;
@@ -1870,7 +1898,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;
@@ -1886,7 +1915,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;
@@ -1907,7 +1936,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);
@@ -1917,7 +1946,7 @@ UpdateStringOfList(
dst++;
}
if (flagPtr != localFlags) {
- ckfree((char *) flagPtr);
+ ckfree(flagPtr);
}
if (dst == listPtr->bytes) {
*dst = 0;
generated by cgit v0.12 at 2024-12-29 20:06:08 (GMT)