summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2007-03-08 11:19:29 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2007-03-08 11:19:29 (GMT)
commit044705529a95670964399979c6f08dbe891338cb (patch)
tree3a03a080b36f7b84e6ed5f94d8b0ef3726b31f20
parentfebd402f818f7db2de0f1890cb936ffc2aebccbe (diff)
downloadtcl-044705529a95670964399979c6f08dbe891338cb.zip
tcl-044705529a95670964399979c6f08dbe891338cb.tar.gz
tcl-044705529a95670964399979c6f08dbe891338cb.tar.bz2
Moved [lindex] guts to tclListObj.c, same as [lset] guts.
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclCmdIL.c210
-rw-r--r--generic/tclListObj.c167
3 files changed, 195 insertions, 188 deletions
diff --git a/ChangeLog b/ChangeLog
index 38a1a4c..a66faa8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2007-03-08 Donal K. Fellows <donal.k.fellows@man.ac.uk>
+
+ * generic/tclListObj.c (TclLindexList, TclLindexFlat): Moved these
+ functions to tclListObj.c from tclCmdIL.c to mirror the way that the
+ equivalent functions for [lset]'s guts are arranged.
+
2007-03-08 Kevin B. Kenny <kennykb@acm.org>
* library/clock.tcl: Further tweaks to the Windows time zone table
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index b94acda..18de024 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdIL.c,v 1.107 2007/03/07 22:34:02 dgp Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.108 2007/03/08 11:19:32 dkf Exp $
*/
#include "tclInt.h"
@@ -30,7 +30,7 @@
typedef struct SortElement {
Tcl_Obj *objPtr; /* Object being sorted. */
- int count; /* number of same elements in list */
+ int count; /* Number of same elements in list. */
struct SortElement *nextPtr;/* Next element in the list, or NULL for end
* of list. */
} SortElement;
@@ -53,7 +53,7 @@ typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t);
typedef struct SortInfo {
int isIncreasing; /* Nonzero means sort in increasing order. */
int sortMode; /* The sort mode. One of SORTMODE_* values
- * defined below */
+ * defined below. */
SortStrCmpFn_t strCmpFn; /* Basic string compare command (used with
* ASCII mode). */
Tcl_Obj *compareCmdPtr; /* The Tcl comparison command when sortMode is
@@ -700,7 +700,7 @@ InfoCommandsCmd(
TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL, 0,
&nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
- if (nsPtr != NULL) { /* we successfully found the pattern's ns */
+ if (nsPtr != NULL) { /* We successfully found the pattern's ns. */
specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
}
} else {
@@ -746,7 +746,7 @@ InfoCommandsCmd(
return TCL_OK;
}
if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
- Tcl_HashTable *tablePtr = NULL; /* Quell warning */
+ Tcl_HashTable *tablePtr = NULL; /* Quell warning. */
for (i=0 ; i<nsPtr->commandPathLength ; i++) {
Namespace *pathNsPtr = nsPtr->commandPathArray[i].nsPtr;
@@ -1120,7 +1120,7 @@ InfoFrameCmd(
if (objc == 2) {
/*
- * Just "info frame"
+ * Just "info frame".
*/
int levels =
@@ -1324,7 +1324,7 @@ InfoFrameCmd(
/*
* 'level'. Common to all frame types. Conditional on having an associated
- * _visible_ CallFrame
+ * _visible_ CallFrame.
*/
if ((framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) {
@@ -1551,7 +1551,7 @@ InfoLevelCmd(
{
Interp *iPtr = (Interp *) interp;
- if (objc == 2) { /* just "info level" */
+ if (objc == 2) { /* just "info level". */
Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->varFramePtr->level));
return TCL_OK;
}
@@ -1671,9 +1671,9 @@ InfoLoadedCmd(
return TCL_ERROR;
}
- if (objc == 2) { /* get loaded pkgs in all interpreters */
+ if (objc == 2) { /* Get loaded pkgs in all interpreters. */
interpName = NULL;
- } else { /* get pkgs just in specified interp */
+ } else { /* Get pkgs just in specified interp. */
interpName = TclGetString(objv[2]);
}
result = TclGetLoadedPackages(interp, interpName);
@@ -1777,7 +1777,7 @@ AppendLocals(
for (i = 0; i < localVarCt; i++) {
/*
- * Skip nameless (temporary) variables and undefined variables
+ * Skip nameless (temporary) variables and undefined variables.
*/
if (!TclIsVarTemporary(localPtr) && !TclIsVarUndefined(varPtr)
@@ -1985,7 +1985,7 @@ InfoProcsCmd(
/*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
&simplePattern);
- if (nsPtr != NULL) { /* we successfully found the pattern's ns */
+ if (nsPtr != NULL) { /* We successfully found the pattern's ns. */
specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
}
} else {
@@ -2305,7 +2305,7 @@ InfoVarsCmd(
/*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
&simplePattern);
- if (nsPtr != NULL) { /* We successfully found the pattern's ns */
+ if (nsPtr != NULL) { /* We successfully found the pattern's ns. */
specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
}
} else {
@@ -2464,7 +2464,8 @@ Tcl_JoinObjCmd(
* pointer to its array of element pointers.
*/
- if (TCL_OK != Tcl_ListObjGetElements(interp, objv[1], &listLen, &elemPtrs)) {
+ if (Tcl_ListObjGetElements(interp, objv[1], &listLen,
+ &elemPtrs) != TCL_OK) {
return TCL_ERROR;
}
@@ -2580,7 +2581,7 @@ Tcl_LindexObjCmd(
Tcl_Obj *CONST objv[]) /* Argument objects. */
{
- Tcl_Obj *elemPtr; /* Pointer to the element being extracted */
+ Tcl_Obj *elemPtr; /* Pointer to the element being extracted. */
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "list ?index...?");
@@ -2616,171 +2617,6 @@ Tcl_LindexObjCmd(
/*
*----------------------------------------------------------------------
*
- * 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;
-
- /*
- * 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.
- */
-
- Tcl_Obj *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 (TCL_OK == TclGetIntForIndex(interp, indexArray[i],
- /*endValue*/ listLen-1, &index)) {
- 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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_LinsertObjCmd --
*
* This object-based procedure is invoked to process the "linsert" Tcl
@@ -3197,11 +3033,11 @@ Tcl_LreplaceObjCmd(
}
/*
- * Note that we call Tcl_ListObjReplace even when numToDelete == 0
- * and objc == 4. In this case, the list value of listPtr is not
- * changed (no elements are removed or added), but by making the
- * call we are assured we end up with a list in canonical form.
- * Resist any temptation to optimize this case away.
+ * Note that we call Tcl_ListObjReplace even when numToDelete == 0 and
+ * objc == 4. In this case, the list value of listPtr is not changed (no
+ * elements are removed or added), but by making the call we are assured
+ * we end up with a list in canonical form. Resist any temptation to
+ * optimize this case away.
*/
Tcl_ListObjReplace(NULL, listPtr, first, numToDelete, objc-4, &(objv[4]));
@@ -3841,7 +3677,7 @@ Tcl_LsearchObjCmd(
}
/*
- * Invert match condition for -not
+ * Invert match condition for -not.
*/
if (negatedMatch) {
@@ -4602,7 +4438,7 @@ DictionaryCompare(
* Convert both chars to lower for the comparison, because
* dictionary sorts are case insensitve. Covert to lower, not
* upper, so chars between Z and a will sort before A (where most
- * other interesting punctuations occur)
+ * other interesting punctuations occur).
*/
uniLeftLower = Tcl_UniCharToLower(uniLeft);
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