summaryrefslogtreecommitdiffstats
path: root/generic/tclListObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclListObj.c')
-rw-r--r--generic/tclListObj.c73
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;
generated by cgit v0.12 at 2024-08-20 12:07:34 (GMT)