diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | doc/lsort.n | 27 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 29 | ||||
| -rw-r--r-- | tests/cmdIL.test | 8 |
4 files changed, 55 insertions, 18 deletions
@@ -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. |