diff options
| -rw-r--r-- | jim.c | 47 | ||||
| -rw-r--r-- | jim_tcl.txt | 7 | ||||
| -rw-r--r-- | tests/lsort.test | 9 |
3 files changed, 57 insertions, 6 deletions
@@ -475,7 +475,7 @@ static int JimCheckConversion(const char *str, const char *endptr) return JIM_OK; } -/* Parses the front of a number to determine it's sign and base +/* Parses the front of a number to determine it's sign and base * Returns the index to start parsing according to the given base */ static int JimNumberBase(const char *str, int *base, int *sign) @@ -6402,6 +6402,7 @@ struct lsort_info { int order; int index; int indexed; + int unique; int (*subfn)(Jim_Obj **, Jim_Obj **); }; @@ -6479,6 +6480,35 @@ static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj) return JimSign(ret) * sort_info->order; } +/* Remove duplicate elements from the (sorted) list in-place, according to the + * comparison function, comp. + * + * Note that the last unique value is kept, not the first + */ +static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs)) +{ + int src; + int dst = 0; + Jim_Obj **ele = listObjPtr->internalRep.listValue.ele; + + for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) { + if (comp(&ele[dst], &ele[src]) == 0) { + /* Match, so replace the dest with the current source */ + Jim_DecrRefCount(sort_info->interp, ele[dst]); + } + else { + /* No match, so keep the current source and move to the next destination */ + dst++; + } + ele[dst] = ele[src]; + } + /* At end of list, keep the final element */ + ele[++dst] = ele[src]; + + /* Set the new length */ + listObjPtr->internalRep.listValue.len = dst; +} + /* Sort a list *in place*. MUST be called with non-shared objects. */ static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info) { @@ -6529,6 +6559,11 @@ static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsor if ((rc = setjmp(info->jmpbuf)) == 0) { qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn); } + + if (info->unique && len > 1) { + ListRemoveDuplicates(listObjPtr, fn); + } + Jim_InvalidateStringRep(listObjPtr); sort_info = prev_info; @@ -12533,10 +12568,10 @@ static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[]) { static const char * const options[] = { - "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", NULL + "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL }; enum - { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX }; + { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE }; Jim_Obj *resObj; int i; int retCode; @@ -12551,13 +12586,14 @@ static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const arg info.type = JIM_LSORT_ASCII; info.order = 1; info.indexed = 0; + info.unique = 0; info.command = NULL; info.interp = interp; for (i = 1; i < (argc - 1); i++) { int option; - if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) + if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG) != JIM_OK) return JIM_ERR; switch (option) { @@ -12579,6 +12615,9 @@ static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const arg case OPT_DECREASING: info.order = -1; break; + case OPT_UNIQUE: + info.unique = 1; + break; case OPT_COMMAND: if (i >= (argc - 2)) { Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1); diff --git a/jim_tcl.txt b/jim_tcl.txt index d2e9636..85d5046 100644 --- a/jim_tcl.txt +++ b/jim_tcl.txt @@ -56,6 +56,7 @@ Changes between 0.74 and 0.75 1. `binary`, `pack` and `unpack` now support floating point 2. `file copy` '-force' handles source and target as the same file 3. `format` now supports +%b+ for binary conversion +3. `lsort` now supports '-unique' and '-real' Changes between 0.73 and 0.74 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -3136,7 +3137,7 @@ the list are to be matched against pattern and must have one of the values below lsort ~~~~~ -+*lsort* ?*-index* 'listindex'? ?*-nocase!-integer|-real|-command* 'cmdname'? ?*-decreasing*|*-increasing*? 'list'+ ++*lsort* ?*-index* 'listindex'? ?*-nocase!-integer|-real|-command* 'cmdname'? ?*-unique*? ?*-decreasing*|*-increasing*? 'list'+ Sort the elements of +'list'+, returning a new list in sorted order. By default, ASCII (or UTF-8) sorting is used, with the result in increasing order. @@ -3156,6 +3157,10 @@ than, equal to, or greater than +'$value2'+, respectively. If +-decreasing+ is specified, the resulting list is in the opposite order to what it would be otherwise. +-increasing+ is the default. +If +-unique+ is specified, then only the last set of duplicate elements found in the list will be retained. +Note that duplicates are determined relative to the comparison used in the sort. Thus if +-index 0+ is used, ++{1 a}+ and +{1 b}+ would be considered duplicates and only the second element, +{1 b}+, would be retained. + If +-index 'listindex'+ is specified, each element of the list is treated as a list and the given index is extracted from the list for comparison. The list index may be any valid list index, such as +1+, +end+ or +end-2+. diff --git a/tests/lsort.test b/tests/lsort.test index b3096a7..a1e5500 100644 --- a/tests/lsort.test +++ b/tests/lsort.test @@ -17,7 +17,7 @@ test lsort-1.1 {Tcl_LsortObjCmd procedure} jim { } {1 {wrong # args: should be "lsort ?options? list"}} test lsort-1.2 {Tcl_LsortObjCmd procedure} jim { list [catch {lsort -foo {1 3 2 5}} msg] $msg -} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -increasing, -index, -integer, -nocase, or -real}} +} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -increasing, -index, -integer, -nocase, -real, or -unique}} test lsort-1.3 {Tcl_LsortObjCmd procedure, default options} { lsort {d e c b a \{ d35 d300} } {a b c d d300 d35 e \{} @@ -182,6 +182,13 @@ test lsort-3.19 {SortCompare procedure, -decreasing option} { test lsort-3.20 {SortCompare procedure, -real option} -body { lsort -real {6...4 3} } -returnCodes error -result {expected number but got "6...4"} +test lsort-3.21 {lsort, unique sort} { + lsort -integer -unique {3 1 2 3 1 4 3} +} {1 2 3 4} +test lsort-3.22 {lsort, unique sort with index} { + # lsort -unique should return the last unique item + lsort -unique -index 0 {{a b} {c b} {a c} {d a}} +} {{a c} {c b} {d a}} test lsort-4.26 {DefaultCompare procedure, signed characters} utf8 { set l [lsort [list "abc\u80" "abc"]] |