summaryrefslogtreecommitdiffstats
path: root/generic/tclListObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclListObj.c')
-rw-r--r--generic/tclListObj.c167
1 files changed, 166 insertions, 1 deletions
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 934f20a..d6e2ef5 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.37 2007/03/07 09:10:11 dkf Exp $
+ * RCS: @(#) $Id: tclListObj.c,v 1.38 2007/03/08 11:19:33 dkf Exp $
*/
#include "tclInt.h"
@@ -962,6 +962,171 @@ Tcl_ListObjReplace(
/*
*----------------------------------------------------------------------
*
+ * TclLindexList --
+ *
+ * This procedure handles the 'lindex' command when objc==3.
+ *
+ * Results:
+ * Returns a pointer to the object extracted, or NULL if an error
+ * occurred. The returned object already includes one reference count for
+ * the pointer returned.
+ *
+ * Side effects:
+ * None.
+ *
+ * Notes:
+ * This procedure is implemented entirely as a wrapper around
+ * TclLindexFlat. All it does is reconfigure the argument format into the
+ * form required by TclLindexFlat, while taking care to manage shimmering
+ * in such a way that we tend to keep the most useful intreps and/or
+ * avoid the most expensive conversions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclLindexList(
+ Tcl_Interp *interp, /* Tcl interpreter. */
+ Tcl_Obj *listPtr, /* List being unpacked. */
+ Tcl_Obj *argPtr) /* Index or index list. */
+{
+
+ int index; /* Index into the list. */
+ Tcl_Obj **indices; /* Array of list indices. */
+ int indexCount; /* Size of the array of list indices. */
+ Tcl_Obj *indexListCopy;
+
+ /*
+ * Determine whether argPtr designates a list or a single index. We have
+ * to be careful about the order of the checks to avoid repeated
+ * shimmering; see TIP#22 and TIP#33 for the details.
+ */
+
+ if (argPtr->typePtr != &tclListType
+ && TclGetIntForIndex(NULL , argPtr, 0, &index) == TCL_OK) {
+ /*
+ * argPtr designates a single index.
+ */
+
+ return TclLindexFlat(interp, listPtr, 1, &argPtr);
+ }
+
+ /*
+ * Here we make a private copy of the index list argument to avoid any
+ * shimmering issues that might invalidate the indices array below while
+ * we are still using it. This is probably unnecessary. It does not appear
+ * that any damaging shimmering is possible, and no test has been devised
+ * to show any error when this private copy is not made. But it's cheap,
+ * and it offers some future-proofing insurance in case the TclLindexFlat
+ * implementation changes in some unexpected way, or some new form of
+ * trace or callback permits things to happen that the current
+ * implementation does not.
+ */
+
+ indexListCopy = TclListObjCopy(NULL, argPtr);
+ if (indexListCopy == NULL) {
+ /*
+ * argPtr designates something that is neither an index nor a
+ * well-formed list. Report the error via TclLindexFlat.
+ */
+
+ return TclLindexFlat(interp, listPtr, 1, &argPtr);
+ }
+
+ Tcl_ListObjGetElements(NULL, indexListCopy, &indexCount, &indices);
+ listPtr = TclLindexFlat(interp, listPtr, indexCount, indices);
+ Tcl_DecrRefCount(indexListCopy);
+ return listPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclLindexFlat --
+ *
+ * This procedure is the core of the 'lindex' command, with all index
+ * arguments presented as a flat list.
+ *
+ * Results:
+ * Returns a pointer to the object extracted, or NULL if an error
+ * occurred. The returned object already includes one reference count for
+ * the pointer returned.
+ *
+ * Side effects:
+ * None.
+ *
+ * Notes:
+ * The reference count of the returned object includes one reference
+ * corresponding to the pointer returned. Thus, the calling code will
+ * usually do something like:
+ * Tcl_SetObjResult(interp, result);
+ * Tcl_DecrRefCount(result);
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclLindexFlat(
+ Tcl_Interp *interp, /* Tcl interpreter. */
+ Tcl_Obj *listPtr, /* Tcl object representing the list. */
+ int indexCount, /* Count of indices. */
+ Tcl_Obj *CONST indexArray[])/* Array of pointers to Tcl objects that
+ * represent the indices in the list. */
+{
+ int i;
+
+ Tcl_IncrRefCount(listPtr);
+
+ for (i=0 ; i<indexCount && listPtr ; i++) {
+ int index, listLen;
+ Tcl_Obj **elemPtrs, *sublistCopy;
+
+ /*
+ * Here we make a private copy of the current sublist, so we avoid any
+ * shimmering issues that might invalidate the elemPtr array below
+ * while we are still using it. See test lindex-8.4.
+ */
+
+ sublistCopy = TclListObjCopy(interp, listPtr);
+ Tcl_DecrRefCount(listPtr);
+ listPtr = NULL;
+
+ if (sublistCopy == NULL) {
+ /*
+ * The sublist is not a list at all => error.
+ */
+
+ break;
+ }
+ Tcl_ListObjGetElements(NULL, sublistCopy, &listLen, &elemPtrs);
+
+ if (TclGetIntForIndex(interp, indexArray[i], /*endValue*/ listLen-1,
+ &index) == TCL_OK) {
+ if (index<0 || index>=listLen) {
+ /*
+ * Index is out of range. Break out of loop with empty result.
+ */
+
+ listPtr = Tcl_NewObj();
+ i = indexCount;
+ } else {
+ /*
+ * Extract the pointer to the appropriate element.
+ */
+
+ listPtr = elemPtrs[index];
+ }
+ Tcl_IncrRefCount(listPtr);
+ }
+ Tcl_DecrRefCount(sublistCopy);
+ }
+
+ return listPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclLsetList --
*
* Core of the 'lset' command when objc == 4. Objv[2] may be either a