summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog9
-rw-r--r--doc/lsort.n27
-rw-r--r--generic/tclCmdIL.c29
-rw-r--r--tests/cmdIL.test8
4 files changed, 55 insertions, 18 deletions
diff --git a/ChangeLog b/ChangeLog
index c201f27..ef3a3f3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2001-09-28 Donal K. Fellows <fellowsd@cs.man.ac.uk>
+
+ * doc/lsort.n: Improved doc...
+ * generic/tclCmdIL.c (Tcl_LsortObjCmd, SortCompare): Made
+ offset-from-end indexing work, and factored out some "magic
+ numbers" for easier understanding. [Bug #465674]
+ * tests/cmdIL.test (cmdIL-1.26): Added test for offset-from-end
+ indexing for lsort.
+
2001-09-28 Vince Darley <vincentdarley@users.sourceforge.net>
* win/tclWinFCmd.c:
diff --git a/doc/lsort.n b/doc/lsort.n
index 2a21aa2..67f7f09 100644
--- a/doc/lsort.n
+++ b/doc/lsort.n
@@ -6,7 +6,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: lsort.n,v 1.9 2001/03/30 00:56:02 hobbs Exp $
+'\" RCS: @(#) $Id: lsort.n,v 1.10 2001/09/28 15:32:17 dkf Exp $
'\"
.so man.macros
.TH lsort n 8.3 Tcl "Tcl Built-In Commands"
@@ -65,15 +65,30 @@ Sort the list in decreasing order (``largest'' items first).
.TP 20
\fB\-index\0\fIindex\fR
If this option is specified, each of the elements of \fIlist\fR must
-itself be a proper Tcl sublist. Instead of sorting based on whole sublists,
-\fBlsort\fR will extract the \fIindex\fR'th element from each sublist
-and sort based on the given element. The keyword \fBend\fP is allowed
-for the \fIindex\fP to sort on the last sublist element. For example,
+itself be a proper Tcl sublist. Instead of sorting based on whole
+sublists, \fBlsort\fR will extract the \fIindex\fR'th element from
+each sublist and sort based on the given element. The keyword
+\fBend\fP is allowed for the \fIindex\fP to sort on the last sublist
+element,
+.VS 8.4
+and \fBend-\fIindex\fR sorts on a sublist element offset from
+the end.
+.VE
+For example,
.RS
.CS
lsort -integer -index 1 {{First 24} {Second 18} {Third 30}}
.CE
-returns \fB{Second 18} {First 24} {Third 30}\fR.
+returns \fB{Second 18} {First 24} {Third 30}\fR, and
+.VS 8.4
+'\"
+'\" This example is from the test suite!
+'\"
+.CS
+lsort -index end-1 {{a 1 e i} {b 2 3 f g} {c 4 5 6 d h}}
+.CE
+returns \fB{c 4 5 6 d h} {a 1 e i} {b 2 3 f g}\fR.
+.VE
This option is much more efficient than using \fB\-command\fR
to achieve the same effect.
.RE
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 9cea6a7..2e8a032 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -14,7 +14,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.33 2001/07/31 19:12:06 vincentdarley Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.34 2001/09/28 15:32:17 dkf Exp $
*/
#include "tclInt.h"
@@ -73,6 +73,13 @@ typedef struct SortInfo {
#define SORTMODE_DICTIONARY 4
/*
+ * Magic values for the index field of the SortInfo structure.
+ * Note that the index "end-1" will be translated to SORTIDX_END-1, etc.
+ */
+#define SORTIDX_NONE -1 /* Not indexed; use whole value. */
+#define SORTIDX_END -2 /* Indexed from end. */
+
+/*
* Forward declarations for procedures defined in this file:
*/
@@ -2768,7 +2775,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
sortInfo.isIncreasing = 1;
sortInfo.sortMode = SORTMODE_ASCII;
- sortInfo.index = -1;
+ sortInfo.index = SORTIDX_NONE;
sortInfo.interp = interp;
sortInfo.resultCode = TCL_OK;
cmdPtr = NULL;
@@ -2809,8 +2816,8 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
-1);
return TCL_ERROR;
}
- if (TclGetIntForIndex(interp, objv[i+1], -2, &sortInfo.index)
- != TCL_OK) {
+ if (TclGetIntForIndex(interp, objv[i+1], SORTIDX_END,
+ &sortInfo.index) != TCL_OK) {
return TCL_ERROR;
}
i++;
@@ -3063,20 +3070,20 @@ SortCompare(objPtr1, objPtr2, infoPtr)
return order;
}
- if (infoPtr->index != -1) {
+ if (infoPtr->index != SORTIDX_NONE) {
/*
* The "-index" option was specified. Treat each object as a
* list, extract the requested element from each list, and
- * compare the elements, not the lists. The special index "end"
- * is signaled here with a large negative index.
+ * compare the elements, not the lists. "end"-relative indices
+ * are signaled here with large negative values.
*/
if (Tcl_ListObjLength(infoPtr->interp, objPtr1, &listLen) != TCL_OK) {
infoPtr->resultCode = TCL_ERROR;
return order;
}
- if (infoPtr->index < -1) {
- index = listLen - 1;
+ if (infoPtr->index < SORTIDX_NONE) {
+ index = listLen + infoPtr->index + 1;
} else {
index = infoPtr->index;
}
@@ -3102,8 +3109,8 @@ SortCompare(objPtr1, objPtr2, infoPtr)
infoPtr->resultCode = TCL_ERROR;
return order;
}
- if (infoPtr->index < -1) {
- index = listLen - 1;
+ if (infoPtr->index < SORTIDX_NONE) {
+ index = listLen + infoPtr->index + 1;
} else {
index = infoPtr->index;
}
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index d6f68a3..694abbd 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -8,7 +8,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: cmdIL.test,v 1.13 2000/09/17 22:40:41 ericm Exp $
+# RCS: @(#) $Id: cmdIL.test,v 1.14 2001/09/28 15:32:17 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -98,6 +98,12 @@ test cmdIL-1.25 {Tcl_LsortObjCmd procedure, order of -index and -command} {
rename testcmp ""
set result
} [list 0 [list [list a b] [list c d]]]
+# Note that the required order only exists in the end-1'th element;
+# indexing using the end element or any fixed offset from the start
+# will not work...
+test cmdIL-1.26 {Tcl_LsortObjCmd procedure, offset indexing from end} {
+ lsort -index end-1 {{a 1 e i} {b 2 3 f g} {c 4 5 6 d h}}
+} {{c 4 5 6 d h} {a 1 e i} {b 2 3 f g}}
# Can't think of any good tests for the MergeSort and MergeLists
# procedures, except a bunch of random lists to sort.