From 2b7d6e025eefe41b48ec7f948602faf2d3bf7055 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 14 Oct 2004 17:20:10 +0000 Subject: TIP#217 implementation --- ChangeLog | 5 +++++ doc/lsort.n | 8 +++++++- generic/tclCmdIL.c | 44 ++++++++++++++++++++++++++++++++------------ tests/cmdIL.test | 10 ++++++++-- 4 files changed, 52 insertions(+), 15 deletions(-) diff --git a/ChangeLog b/ChangeLog index c3b855c..0e5e72b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,10 @@ 2004-10-14 Donal K. Fellows + TIP#217 IMPLEMENTATION + + * generic/tclCmdIL.c (Tcl_LsortObjCmd): Add -indices option from + James Salsman. [Patch 1017532] + * generic/tclUtil.c (TclMatchIsTrivial): Detect degenerate cases of glob matching that let us avoid scanning through hash tables. * generic/tclCmdIL.c (InfoCommandsCmd, InfoGlobalsCmd, InfoProcsCmd): diff --git a/doc/lsort.n b/doc/lsort.n index 3763ee6..9e29db3 100644 --- a/doc/lsort.n +++ b/doc/lsort.n @@ -7,7 +7,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.16 2004/08/31 15:19:36 dkf Exp $ +'\" RCS: @(#) $Id: lsort.n,v 1.17 2004/10/14 17:20:11 dkf Exp $ '\" .so man.macros .TH lsort n 8.3 Tcl "Tcl Built-In Commands" @@ -65,6 +65,12 @@ This is the default. \fB\-decreasing\fR Sort the list in decreasing order (``largest'' items first). .TP 20 +\fB\-indices\fR +.VS "8.5 (TIP#217)" +Return a list of indices into \fIlist\fR in sorted order instead of +the values themselves. +.VE "8.5 (TIP#217)" +.TP 20 \fB\-index\0\fIindexList\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 diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 2997509..2204d1f 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -15,7 +15,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.65 2004/10/14 15:06:01 dkf Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.66 2004/10/14 17:20:11 dkf Exp $ */ #include "tclInt.h" @@ -3751,7 +3751,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv) int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument values. */ { - int i, index, unique; + int i, index, unique, indices; Tcl_Obj *resultPtr; int length; Tcl_Obj *cmdPtr, **listObjPtrs; @@ -3762,12 +3762,12 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv) * comparison function */ static CONST char *switches[] = { "-ascii", "-command", "-decreasing", "-dictionary", "-increasing", - "-index", "-integer", "-real", "-unique", (char *) NULL + "-index", "-indices", "-integer", "-real", "-unique", (char *) NULL }; enum Lsort_Switches { LSORT_ASCII, LSORT_COMMAND, LSORT_DECREASING, LSORT_DICTIONARY, - LSORT_INCREASING, LSORT_INDEX, LSORT_INTEGER, LSORT_REAL, - LSORT_UNIQUE + LSORT_INCREASING, LSORT_INDEX, LSORT_INDICES, LSORT_INTEGER, + LSORT_REAL, LSORT_UNIQUE }; if (objc < 2) { @@ -3787,6 +3787,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv) sortInfo.resultCode = TCL_OK; cmdPtr = NULL; unique = 0; + indices = 0; for (i = 1; i < objc-1; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index) != TCL_OK) { @@ -3884,6 +3885,9 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv) case LSORT_UNIQUE: unique = 1; break; + case LSORT_INDICES: + indices = 1; + break; } } @@ -3928,16 +3932,32 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv) if (sortInfo.resultCode == TCL_OK) { resultPtr = Tcl_NewObj(); if (unique) { - for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){ - if (elementPtr->count == 0) { - Tcl_ListObjAppendElement(interp, resultPtr, - elementPtr->objPtr); + if (indices) { + for (; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) { + if (elementPtr->count == 0) { + Tcl_ListObjAppendElement(interp, resultPtr, + Tcl_NewIntObj(elementPtr - &elementArray[0])); + } + } + } else { + for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr) { + if (elementPtr->count == 0) { + Tcl_ListObjAppendElement(interp, resultPtr, + elementPtr->objPtr); + } } } } else { - for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){ - Tcl_ListObjAppendElement(interp, resultPtr, - elementPtr->objPtr); + if (indices) { + for (; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) { + Tcl_ListObjAppendElement(interp, resultPtr, + Tcl_NewIntObj(elementPtr - &elementArray[0])); + } + } else { + for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){ + Tcl_ListObjAppendElement(interp, resultPtr, + elementPtr->objPtr); + } } } Tcl_SetObjResult(interp, resultPtr); diff --git a/tests/cmdIL.test b/tests/cmdIL.test index e9b1432..156c4dd 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.22 2004/01/18 16:19:06 dkf Exp $ +# RCS: @(#) $Id: cmdIL.test,v 1.23 2004/10/14 17:20:11 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -23,7 +23,7 @@ test cmdIL-1.1 {Tcl_LsortObjCmd procedure} { } {1 {wrong # args: should be "lsort ?options? list"}} test cmdIL-1.2 {Tcl_LsortObjCmd procedure} { list [catch {lsort -foo {1 3 2 5}} msg] $msg -} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -integer, -real, or -unique}} +} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -real, or -unique}} test cmdIL-1.3 {Tcl_LsortObjCmd procedure, default options} { lsort {d e c b a \{ d35 d300} } {a b c d d300 d35 e \{} @@ -112,6 +112,12 @@ test cmdIL-1.25 {Tcl_LsortObjCmd procedure, order of -index and -command} -setup 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}} +test cmdIL-1.27 {Tcl_LsortObjCmd procedure, returning indices} { + lsort -indices {a c b} +} {0 2 1} +test cmdIL-1.28 {Tcl_LsortObjCmd procedure, returning indices} { + lsort -indices -unique -decreasing -real {1.2 34.5 34.5 5.6} +} {2 3 0} # Can't think of any good tests for the MergeSort and MergeLists # procedures, except a bunch of random lists to sort. -- cgit v0.12