summaryrefslogtreecommitdiffstats
path: root/generic/tclListObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclListObj.c')
-rw-r--r--generic/tclListObj.c219
1 files changed, 93 insertions, 126 deletions
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index f619f8b..7278384 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclListObj.c,v 1.42 2007/03/17 05:04:16 dgp Exp $
+ * RCS: @(#) $Id: tclListObj.c,v 1.43 2007/03/20 19:47:48 kennykb Exp $
*/
#include "tclInt.h"
@@ -1255,22 +1255,12 @@ TclLsetFlat(
/* Index args. */
Tcl_Obj *valuePtr) /* Value arg to 'lset'. */
{
- int duplicated; /* Flag == 1 if the obj has been duplicated, 0
- * otherwise. */
- Tcl_Obj *retValuePtr; /* Pointer to the list to be returned. */
- int elemCount; /* Length of one sublist being changed. */
- Tcl_Obj **elemPtrs; /* Pointers to the elements of a sublist. */
- Tcl_Obj *subListPtr; /* Pointer to the current sublist. */
- int index; /* Index of the element to replace in the
- * current sublist. */
- Tcl_Obj *chainPtr; /* Pointer to the enclosing list of the
- * current sublist. */
- int result; /* Status return from library calls. */
- int i;
+ int index, result;
+ Tcl_Obj *subListPtr, *retValuePtr, *chainPtr;
/*
- * If there are no indices, then simply return the new value, counting the
- * returned pointer as a reference.
+ * If there are no indices, simply return the new value.
+ * (Without indices, [lset] is a synonym for [set].
*/
if (indexCount == 0) {
@@ -1279,163 +1269,140 @@ TclLsetFlat(
}
/*
- * If the list is shared, make a private copy. Duplicate the intrep to
- * insure that it is modifyable [Bug 1333036]. A plain Tcl_DuplicateObj
- * will just increase the intrep's refCount without upping the sublists'
- * refCount, so that their true shared status cannot be determined from
- * their refCount.
+ * 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 (Tcl_IsShared(listPtr)) {
- duplicated = 1;
- if (listPtr->typePtr == &tclListType) {
- result = Tcl_ListObjGetElements(interp, listPtr, &elemCount,
- &elemPtrs);
- listPtr = Tcl_NewListObj(elemCount, elemPtrs);
- } else {
- listPtr = Tcl_DuplicateObj(listPtr);
- }
- Tcl_IncrRefCount(listPtr);
- } else {
- duplicated = 0;
- }
+ subListPtr = Tcl_IsShared(listPtr) ? Tcl_DuplicateObj(listPtr) : listPtr;
/*
* Anchor the linked list of Tcl_Obj's whose string reps must be
* invalidated if the operation succeeds.
*/
- retValuePtr = listPtr;
+ retValuePtr = subListPtr;
chainPtr = NULL;
/*
- * Handle each index arg by diving into the appropriate sublist.
+ * Loop through all the index arguments, and for each one dive
+ * into the appropriate sublist.
*/
- for (i=0 ; ; i++) {
- /*
- * Take the sublist apart.
- */
+ do {
+ int elemCount;
+ Tcl_Obj *parentList, **elemPtrs;
- result = Tcl_ListObjGetElements(interp, listPtr, &elemCount,
- &elemPtrs);
- if (result != TCL_OK) {
+ /* Check for the possible error conditions... */
+ result = TCL_ERROR;
+ if (Tcl_ListObjGetElements(interp, subListPtr, &elemCount, &elemPtrs)
+ != TCL_OK) {
+ /* ...the sublist we're indexing into isn't a list at all. */
break;
}
- if (elemCount == 0) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("list index out of range", -1));
- result = TCL_ERROR;
- break;
- }
- listPtr->internalRep.twoPtrValue.ptr2 = (void *) chainPtr;
-
- /*
- * Determine the index of the requested element.
- */
- result = TclGetIntForIndex(interp, indexArray[i], elemCount-1, &index);
- if (result != TCL_OK) {
+ if (TclGetIntForIndex(interp, *indexArray++, elemCount - 1, &index)
+ != TCL_OK) {
+ /* ...the index we're trying to use isn't an index at all. */
break;
}
- /*
- * Check that the index is in range.
- */
-
- 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));
- result = TCL_ERROR;
break;
}
/*
- * Break the loop after extracting the innermost sublist.
+ * 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.
*/
- if (i >= indexCount-1) {
- result = TCL_OK;
- break;
- }
-
- /*
- * Extract the appropriate sublist, and make sure that it is unshared.
- * If it is a list, duplicate the intrep to avoid [Bug 1333036], as
- * per the previous comment.
- */
-
- subListPtr = elemPtrs[index];
- if (Tcl_IsShared(subListPtr)) {
- if (subListPtr->typePtr == &tclListType) {
- result = Tcl_ListObjGetElements(interp, subListPtr, &elemCount,
- &elemPtrs);
- subListPtr = Tcl_NewListObj(elemCount, elemPtrs);
- } else {
+ result = TCL_OK;
+ if (--indexCount) {
+ parentList = subListPtr;
+ subListPtr = elemPtrs[index];
+ if (Tcl_IsShared(subListPtr)) {
subListPtr = Tcl_DuplicateObj(subListPtr);
}
- result = TclListObjSetElement(interp, listPtr, index, subListPtr);
- if (result != TCL_OK) {
- /*
- * We actually shouldn't be able to get here. If we do, it
- * would result in leaking subListPtr, but everything's been
- * validated already; the error exit from TclListObjSetElement
- * should never happen.
- */
- break;
+ /*
+ * Replace the original elemPtr[index] in parentList with a copy
+ * 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.
+ */
+
+ TclListObjSetElement(NULL, parentList, index, subListPtr);
+ if (Tcl_IsShared(subListPtr)) {
+ subListPtr = Tcl_DuplicateObj(subListPtr);
+ TclListObjSetElement(NULL, parentList, index, subListPtr);
}
- }
- /*
- * Chain the current sublist onto the linked list of Tcl_Obj's whose
- * string reps must be spoilt.
- */
+ /*
+ * 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.
+ */
- chainPtr = listPtr;
- listPtr = subListPtr;
- }
+ parentList->internalRep.twoPtrValue.ptr2 = (void *) chainPtr;
+ chainPtr = parentList;
+ }
+ } while (indexCount > 0);
/*
- * Store the result in the list element.
+ * 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.
*/
- if (result == TCL_OK) {
- result = TclListObjSetElement(interp, listPtr, index, valuePtr);
- }
+ while (chainPtr) {
+ Tcl_Obj *objPtr = chainPtr;
- if (result == TCL_OK) {
- listPtr->internalRep.twoPtrValue.ptr2 = (void *) chainPtr;
+ if (result == TCL_OK) {
- /*
- * Spoil all the string reps.
- */
+ /*
+ * We're going to store valuePtr, so spoil string reps
+ * of all containing lists.
+ */
- while (listPtr != NULL) {
- subListPtr = (Tcl_Obj *) listPtr->internalRep.twoPtrValue.ptr2;
- Tcl_InvalidateStringRep(listPtr);
- listPtr->internalRep.twoPtrValue.ptr2 = NULL;
- listPtr = subListPtr;
+ Tcl_InvalidateStringRep(objPtr);
}
- /*
- * Return the new list if everything worked.
- */
-
- if (!duplicated) {
- Tcl_IncrRefCount(retValuePtr);
- }
- return retValuePtr;
+ /* Clear away our intrep surgery mess */
+ chainPtr = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
}
- /*
- * Clean up the one dangling reference otherwise.
- */
-
- if (duplicated) {
- Tcl_DecrRefCount(retValuePtr);
+ if (result != TCL_OK) {
+ /* Error return; message is already in interp */
+ return NULL;
}
- return NULL;
+
+ /* Store valuePtr in proper sublist and return */
+ TclListObjSetElement(NULL, subListPtr, index, valuePtr);
+ Tcl_InvalidateStringRep(subListPtr);
+ Tcl_IncrRefCount(retValuePtr);
+ return retValuePtr;
}
/*