diff options
| -rw-r--r-- | jim.c | 52 | ||||
| -rw-r--r-- | tests/lsort.test | 129 |
2 files changed, 177 insertions, 4 deletions
@@ -6904,7 +6904,8 @@ struct lsort_info { JIM_LSORT_NOCASE, JIM_LSORT_INTEGER, JIM_LSORT_REAL, - JIM_LSORT_COMMAND + JIM_LSORT_COMMAND, + JIM_LSORT_DICT } type; int order; Jim_Obj **indexv; @@ -6937,6 +6938,45 @@ static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj) return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order; } +static int ListSortDict(Jim_Obj **lhsObj, Jim_Obj **rhsObj) +{ + /* XXX Does not compare past embedded nulls */ + const char *left = Jim_String(*lhsObj); + const char *right = Jim_String(*rhsObj); + + while (1) { + if (isdigit(UCHAR(*left)) && isdigit(UCHAR(*right))) { + /* extract and compare integers */ + jim_wide lint, rint; + char *lend, *rend; + lint = jim_strtoull(left, &lend); + rint = jim_strtoull(right, &rend); + if (lint != rint) { + return JimSign(lint - rint) * sort_info->order; + } + /* If the integers are equal but of unequal length, then one must have more leading + * zeros. The shorter one compares less */ + if (lend -left != rend - right) { + return JimSign((lend - left) - (rend - right)) * sort_info->order; + } + left = lend; + right = rend; + } + else { + int cl, cr; + left += utf8_tounicode_case(left, &cl, 1); + right += utf8_tounicode_case(right, &cr, 1); + if (cl != cr) { + return JimSign(cl - cr) * sort_info->order; + } + if (cl == 0) { + /* If they compare equal, use a case sensitive comparison as a tie breaker */ + return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order; + } + } + } +} + static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj) { jim_wide lhs = 0, rhs = 0; @@ -7056,6 +7096,9 @@ static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsor case JIM_LSORT_COMMAND: fn = ListSortCommand; break; + case JIM_LSORT_DICT: + fn = ListSortDict; + break; default: fn = NULL; /* avoid warning */ JimPanic((1, "ListSort called with invalid sort type")); @@ -13413,11 +13456,11 @@ static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const arg { static const char * const options[] = { "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", - "-stride", NULL + "-stride", "-dictionary", NULL }; enum { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE, - OPT_STRIDE + OPT_STRIDE, OPT_DICT }; Jim_Obj *resObj; int i; @@ -13452,6 +13495,9 @@ wrongargs: case OPT_ASCII: info.type = JIM_LSORT_ASCII; break; + case OPT_DICT: + info.type = JIM_LSORT_DICT; + break; case OPT_NOCASE: info.type = JIM_LSORT_NOCASE; break; diff --git a/tests/lsort.test b/tests/lsort.test index 5297568..4e5c2b3 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, -real, -stride, or -unique}} +} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -integer, -nocase, -real, -stride, 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 \{} @@ -207,6 +207,12 @@ test lsort-5.1 "Sort case insensitive" { lsort -nocase {ba aB aa ce} } {aa aB ba ce} +test cmdIL-1.8 {Tcl_LsortObjCmd procedure, -dictionary option} { + lsort -dictionary {d e c b a d35 d300} +} {a b c d d35 d300 e} +test cmdIL-1.9 {Tcl_LsortObjCmd procedure, -dictionary option} { + lsort -dictionary {1k 0k 10k} +} {0k 1k 10k} test cmdIL-1.30 {Tcl_LsortObjCmd procedure, -stride option} { lsort -stride 2 {f e d c b a} } {b a d c f e} @@ -237,5 +243,126 @@ test cmdIL-1.41 {lsort -stride and -index} -body { test cmdIL-1.42 {lsort -stride and-index} -body { lsort -stride 2 -index -1-1 {a 2 b 1} } -returnCodes error -result {index "-1-1" out of range} +test cmdIL-3.8 {SortCompare procedure, -dictionary option} { + lsort -dictionary {d e c b a d35 d300 100 20} +} {20 100 a b c d d35 d300 e} + +test cmdIL-4.1 {DictionaryCompare procedure, numerics, leading zeros} { + lsort -dictionary {a003b a03b} +} {a03b a003b} +test cmdIL-4.2 {DictionaryCompare procedure, numerics, leading zeros} { + lsort -dictionary {a3b a03b} +} {a3b a03b} +# This test fails in Jim because we don't bother falling back to a secondary +# sort on case if the primary sort (with leading zeros) is equal. +test cmdIL-4.3 {DictionaryCompare procedure, numerics, leading zeros} tcl { + lsort -dictionary {a3b A03b} +} {A03b a3b} +test cmdIL-4.4 {DictionaryCompare procedure, numerics, leading zeros} { + lsort -dictionary {a3b a03B} +} {a3b a03B} +test cmdIL-4.5 {DictionaryCompare procedure, numerics, leading zeros} { + lsort -dictionary {00000 000} +} {000 00000} +test cmdIL-4.6 {DictionaryCompare procedure, numerics, different lengths} { + lsort -dictionary {a321b a03210b} +} {a321b a03210b} +test cmdIL-4.7 {DictionaryCompare procedure, numerics, different lengths} { + lsort -dictionary {a03210b a321b} +} {a321b a03210b} +test cmdIL-4.8 {DictionaryCompare procedure, numerics} { + lsort -dictionary {48 6a 18b 22a 21aa 35 36} +} {6a 18b 21aa 22a 35 36 48} +test cmdIL-4.9 {DictionaryCompare procedure, numerics} { + lsort -dictionary {a123x a123b} +} {a123b a123x} +test cmdIL-4.10 {DictionaryCompare procedure, numerics} { + lsort -dictionary {a123b a123x} +} {a123b a123x} +test cmdIL-4.11 {DictionaryCompare procedure, numerics} { + lsort -dictionary {a1b aab} +} {a1b aab} +test cmdIL-4.12 {DictionaryCompare procedure, numerics} { + lsort -dictionary {a1b a!b} +} {a!b a1b} +test cmdIL-4.13 {DictionaryCompare procedure, numerics} { + lsort -dictionary {a1b2c a1b1c} +} {a1b1c a1b2c} +test cmdIL-4.14 {DictionaryCompare procedure, numerics} { + lsort -dictionary {a1b2c a1b3c} +} {a1b2c a1b3c} +test cmdIL-4.15 {DictionaryCompare procedure, long numbers} { + lsort -dictionary {a7654884321988762b a7654884321988761b} +} {a7654884321988761b a7654884321988762b} +test cmdIL-4.16 {DictionaryCompare procedure, long numbers} { + lsort -dictionary {a8765488432198876b a7654884321988761b} +} {a7654884321988761b a8765488432198876b} +test cmdIL-4.17 {DictionaryCompare procedure, case} { + lsort -dictionary {aBCd abcc} +} {abcc aBCd} +test cmdIL-4.18 {DictionaryCompare procedure, case} { + lsort -dictionary {aBCd abce} +} {aBCd abce} +test cmdIL-4.19 {DictionaryCompare procedure, case} { + lsort -dictionary {abcd ABcc} +} {ABcc abcd} +test cmdIL-4.20 {DictionaryCompare procedure, case} { + lsort -dictionary {abcd ABce} +} {abcd ABce} +test cmdIL-4.21 {DictionaryCompare procedure, case} { + lsort -dictionary {abCD ABcd} +} {ABcd abCD} +test cmdIL-4.22 {DictionaryCompare procedure, case} { + lsort -dictionary {ABcd aBCd} +} {ABcd aBCd} +test cmdIL-4.23 {DictionaryCompare procedure, case} { + lsort -dictionary {ABcd AbCd} +} {ABcd AbCd} +test cmdIL-4.24 {DictionaryCompare procedure, international characters} { + set result [lsort -dictionary "a b c A B C \xe3 \xc4"] + set result +} "A a B b C c \xe3 \xc4" +test cmdIL-4.25 {DictionaryCompare procedure, international characters} { + set result [lsort -dictionary "a23\xe3 a23\xc5 a23\xe4"] + set result +} "a23\xe3 a23\xe4 a23\xc5" +test cmdIL-4.26 {DefaultCompare procedure, signed characters} { + set l [lsort [list "abc\200" "abc"]] + set viewlist {} + foreach s $l { + set viewelem "" + set len [string length $s] + for {set i 0} {$i < $len} {incr i} { + set c [string index $s $i] + scan $c %c d + if {$d > 0 && $d < 128} { + append viewelem $c + } else { + append viewelem "\\[format %03o $d]" + } + } + lappend viewlist $viewelem + } + set viewlist +} [list "abc" "abc\\200"] +test cmdIL-4.27 {DictionaryCompare procedure, signed characters} { + set l [lsort -dictionary [list "abc\200" "abc"]] + set viewlist {} + foreach s $l { + set viewelem "" + set len [string length $s] + for {set i 0} {$i < $len} {incr i} { + set c [string index $s $i] + scan $c %c d + if {$d > 0 && $d < 128} { + append viewelem $c + } else { + append viewelem "\\[format %03o $d]" + } + } + lappend viewlist $viewelem + } + set viewlist +} [list "abc" "abc\\200"] testreport |