diff options
| -rw-r--r-- | jim.c | 285 | ||||
| -rw-r--r-- | jim_tcl.txt | 86 | ||||
| -rw-r--r-- | tests/lsearch.test | 113 | ||||
| -rw-r--r-- | tests/lsort.test | 48 |
4 files changed, 441 insertions, 91 deletions
@@ -139,6 +139,8 @@ static char JimEmptyStringRep[] = ""; static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action); static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr, int flags); +static int Jim_ListIndices(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *const *indexv, int indexc, + Jim_Obj **resultObj, int flags); static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands); static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr); static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr); @@ -6722,7 +6724,7 @@ Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len) * sure that the list object can't shimmer while the vector returned * is in use, this vector is the one stored inside the internal representation * of the list object. This function is not exported, extensions should - * always access to the List object elements using Jim_ListIndex(). */ + * always access to the List object elements using Jim_ListGetIndex(). */ static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen, Jim_Obj ***listVec) { @@ -6755,8 +6757,8 @@ struct lsort_info { JIM_LSORT_COMMAND } type; int order; - int index; - int indexed; + Jim_Obj **indexv; + int indexc; int unique; int (*subfn)(Jim_Obj **, Jim_Obj **); }; @@ -6767,8 +6769,8 @@ static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj) { Jim_Obj *lObj, *rObj; - if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK || - Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) { + if (Jim_ListIndices(sort_info->interp, *lhsObj, sort_info->indexv, sort_info->indexc, &lObj, JIM_ERRMSG) != JIM_OK || + Jim_ListIndices(sort_info->interp, *rhsObj, sort_info->indexv, sort_info->indexc, &rObj, JIM_ERRMSG) != JIM_OK) { longjmp(sort_info->jmpbuf, JIM_ERR); } return sort_info->subfn(&lObj, &rObj); @@ -6910,7 +6912,7 @@ static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsor return -1; /* Should not be run but keeps static analysers happy */ } - if (info->indexed) { + if (info->indexc) { /* Need to interpose a "list index" function */ info->subfn = fn; fn = ListSortIndexHelper; @@ -7059,6 +7061,57 @@ int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPt return JIM_OK; } +/* Get the value from the list associated to the specified list indices. + * Return JIM_ERR if an index is invalid (and sets an error message). + * Returns -1 if the list index is out of range. + * In this case, if flags includes JIM_ERRMSG, an error result is set. + * Otherwise, returns JIM_OK and sets *resultObj to the indexed value. + * (This is the only case where *resultObj is set) + */ +static int Jim_ListIndices(Jim_Interp *interp, Jim_Obj *listPtr, + Jim_Obj *const *indexv, int indexc, Jim_Obj **resultObj, int flags) +{ + int i; + int static_idxes[5]; + int *idxes = static_idxes; + int ret = JIM_OK; + + if (indexc > sizeof(static_idxes) / sizeof(*static_idxes)) { + idxes = Jim_Alloc(indexc * sizeof(*idxes)); + } + + /* In the rare, contrived case where an index is also the list (or an element) + * we need to extract the indices first. + */ + for (i = 0; i < indexc; i++) { + ret = Jim_GetIndex(interp, indexv[i], &idxes[i]); + if (ret != JIM_OK) { + goto err; + } + } + + for (i = 0; i < indexc; i++) { + Jim_Obj *objPtr = Jim_ListGetIndex(interp, listPtr, idxes[i]); + if (!objPtr) { + if (flags & JIM_ERRMSG) { + if (idxes[i] < 0 || idxes[i] > Jim_ListLength(interp, listPtr)) { + Jim_SetResultFormatted(interp, "index \"%#s\" out of range", indexv[i]); + } + else { + Jim_SetResultFormatted(interp, "element %#s missing from sublist \"%#s\"", indexv[i], listPtr); + } + } + return -1; + } + listPtr = objPtr; + } + *resultObj = listPtr; +err: + if (idxes != static_idxes) + Jim_Free(idxes); + return ret; +} + static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj *newObjPtr, int flags) { @@ -7096,7 +7149,10 @@ int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr, listObjPtr = objPtr; if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK) goto err; - if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) { + + objPtr = Jim_ListGetIndex(interp, listObjPtr, idx); + if (objPtr == NULL) { + Jim_SetResultFormatted(interp, "index \"%#s\" out of range", indexv[i]); goto err; } if (Jim_IsShared(objPtr)) { @@ -12694,35 +12750,24 @@ static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg /* [lindex] */ static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { - Jim_Obj *objPtr, *listObjPtr; - int i; - int idx; + Jim_Obj *objPtr; + int ret; if (argc < 2) { Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?"); return JIM_ERR; } - objPtr = argv[1]; - Jim_IncrRefCount(objPtr); - for (i = 2; i < argc; i++) { - listObjPtr = objPtr; - if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) { - Jim_DecrRefCount(interp, listObjPtr); - return JIM_ERR; - } - if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) { - /* Returns an empty object if the index - * is out of range. */ - Jim_DecrRefCount(interp, listObjPtr); - Jim_SetEmptyResult(interp); - return JIM_OK; - } - Jim_IncrRefCount(objPtr); - Jim_DecrRefCount(interp, listObjPtr); + ret = Jim_ListIndices(interp, argv[1], argv + 2, argc - 2, &objPtr, JIM_NONE); + if (ret < 0) { + /* Returns an empty object if the index + * is out of range. */ + ret = JIM_OK; + Jim_SetEmptyResult(interp); } - Jim_SetResult(interp, objPtr); - Jim_DecrRefCount(interp, objPtr); - return JIM_OK; + else if (ret == JIM_OK) { + Jim_SetResult(interp, objPtr); + } + return ret; } /* [llength] */ @@ -12741,11 +12786,11 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const * { static const char * const options[] = { "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command", - NULL + "-stride", "-index", NULL }; enum { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE, - OPT_COMMAND }; + OPT_COMMAND, OPT_STRIDE, OPT_INDEX }; int i; int opt_bool = 0; int opt_not = 0; @@ -12756,12 +12801,14 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const * int rc = JIM_OK; Jim_Obj *listObjPtr = NULL; Jim_Obj *commandObj = NULL; + Jim_Obj *indexObj = NULL; int match_flags = 0; + long stride = 1; if (argc < 3) { wrongargs: Jim_WrongNumArgs(interp, 1, argv, - "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value"); + "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? ?-stride len? ?-index val? list value"); return JIM_ERR; } @@ -12803,6 +12850,24 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const * case OPT_GLOB: opt_match = option; break; + case OPT_INDEX: + if (i >= argc - 2) { + goto wrongargs; + } + indexObj = argv[++i]; + break; + case OPT_STRIDE: + if (i >= argc - 2) { + goto wrongargs; + } + if (Jim_GetLong(interp, argv[++i], &stride) != JIM_OK) { + return JIM_ERR; + } + if (stride < 1) { + Jim_SetResultString(interp, "stride length must be at least 1", -1); + return JIM_ERR; + } + break; } } @@ -12812,6 +12877,12 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const * } argv += i; + listlen = Jim_ListLength(interp, argv[0]); + if (listlen % stride) { + Jim_SetResultString(interp, "list size must be a multiple of the stride length", -1); + return JIM_ERR; + } + if (opt_all) { listObjPtr = Jim_NewListObj(interp, NULL, 0); } @@ -12822,10 +12893,41 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const * Jim_IncrRefCount(commandObj); } - listlen = Jim_ListLength(interp, argv[0]); - for (i = 0; i < listlen; i++) { + for (i = 0; i < listlen; i += stride) { int eq = 0; - Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i); + Jim_Obj *searchListObj; + Jim_Obj *objPtr; + int offset; + + if (indexObj) { + int indexlen = Jim_ListLength(interp, indexObj); + if (stride == 1) { + searchListObj = Jim_ListGetIndex(interp, argv[0], i); + } + else { + searchListObj = Jim_NewListObj(interp, argv[0]->internalRep.listValue.ele + i, stride); + } + Jim_IncrRefCount(searchListObj); + rc = Jim_ListIndices(interp, searchListObj, indexObj->internalRep.listValue.ele, indexlen, &objPtr, JIM_ERRMSG); + if (rc != JIM_OK) { + Jim_DecrRefCount(interp, searchListObj); + rc = JIM_ERR; + goto done; + } + /* now indexObj is the object to compare */ + offset = 0; + } + else { + /* No -index, so we have an implicit {0} as indexObj */ + searchListObj = argv[0]; + offset = i; + objPtr = Jim_ListGetIndex(interp, searchListObj, i); + Jim_IncrRefCount(searchListObj); + } + /* At this point objPtr represents the object to search against and + * searchListObj represents the list we search in (offset .. offset + stride - 1) + * both need to have reference counts decremented when done + */ switch (opt_match) { case OPT_EXACT: @@ -12840,22 +12942,15 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const * case OPT_COMMAND: eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, match_flags); if (eq < 0) { - if (listObjPtr) { - Jim_FreeNewObj(interp, listObjPtr); - } + Jim_DecrRefCount(interp, searchListObj); rc = JIM_ERR; goto done; } break; } - /* If we have a non-match with opt_bool, opt_not, !opt_all, can't exit early */ - if (!eq && opt_bool && opt_not && !opt_all) { - continue; - } - + /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */ if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) { - /* Got a match (or non-match for opt_not), or (opt_bool && opt_all) */ Jim_Obj *resultObj; if (opt_bool) { @@ -12864,22 +12959,36 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const * else if (!opt_inline) { resultObj = Jim_NewIntObj(interp, i); } - else { + else if (stride == 1) { resultObj = objPtr; } + else if (opt_all) { + /* Add the entire sublist directly for -all -stride > 1 */ + ListInsertElements(listObjPtr, -1, stride, + searchListObj->internalRep.listValue.ele + offset); + } + else { + resultObj = Jim_NewListObj(interp, searchListObj->internalRep.listValue.ele + offset, stride); + } if (opt_all) { - Jim_ListAppendElement(interp, listObjPtr, resultObj); + /* The stride > 1 case has already been handled above */ + if (stride == 1) { + Jim_ListAppendElement(interp, listObjPtr, resultObj); + } } else { Jim_SetResult(interp, resultObj); + Jim_DecrRefCount(interp, searchListObj); goto done; } } + Jim_DecrRefCount(interp, searchListObj); } if (opt_all) { Jim_SetResult(interp, listObjPtr); + listObjPtr = NULL; } else { /* No match */ @@ -12892,6 +13001,9 @@ static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const * } done: + if (listObjPtr) { + Jim_FreeNewObj(interp, listObjPtr); + } if (commandObj) { Jim_DecrRefCount(interp, commandObj); } @@ -13028,25 +13140,30 @@ 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", "-unique", NULL + "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", + "-stride", NULL + }; + enum { + OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE, + OPT_STRIDE }; - enum - { 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; int shared; + long stride = 1; struct lsort_info info; if (argc < 2) { +wrongargs: Jim_WrongNumArgs(interp, 1, argv, "?options? list"); return JIM_ERR; } info.type = JIM_LSORT_ASCII; info.order = 1; - info.indexed = 0; + info.indexc = 0; info.unique = 0; info.command = NULL; info.interp = interp; @@ -13088,28 +13205,72 @@ static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const arg info.command = argv[i + 1]; i++; break; + case OPT_STRIDE: + if (i >= argc - 2) { + goto wrongargs; + } + if (Jim_GetLong(interp, argv[++i], &stride) != JIM_OK) { + return JIM_ERR; + } + if (stride < 2) { + Jim_SetResultString(interp, "stride length must be at least 2", -1); + return JIM_ERR; + } + break; case OPT_INDEX: if (i >= (argc - 2)) { +badindex: Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1); return JIM_ERR; } - if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) { - return JIM_ERR; + JimListGetElements(interp, argv[i + 1], &info.indexc, &info.indexv); + if (info.indexc == 0) { + goto badindex; } - info.indexed = 1; i++; break; } } resObj = argv[argc - 1]; - if ((shared = Jim_IsShared(resObj))) - resObj = Jim_DuplicateObj(interp, resObj); - retCode = ListSortElements(interp, resObj, &info); - if (retCode == JIM_OK) { - Jim_SetResult(interp, resObj); - } - else if (shared) { - Jim_FreeNewObj(interp, resObj); + if (stride > 1) { + Jim_Obj *tmpListObj; + Jim_Obj **elements; + int listlen; + int i; + + JimListGetElements(interp, resObj, &listlen, &elements); + if (listlen % stride) { + Jim_SetResultString(interp, "list size must be a multiple of the stride length", -1); + return JIM_ERR; + } + /* Need to create a new list of lists for sorting */ + tmpListObj = Jim_NewListObj(interp, NULL, 0); + Jim_IncrRefCount(tmpListObj); + for (i = 0; i < listlen; i += stride) { + Jim_ListAppendElement(interp, tmpListObj, Jim_NewListObj(interp, elements + i, stride)); + } + retCode = ListSortElements(interp, tmpListObj, &info); + if (retCode == JIM_OK) { + resObj = Jim_NewListObj(interp, NULL, 0); + /* Now we need to unpack the result back into a flat list */ + for (i = 0; i < listlen; i += stride) { + Jim_ListAppendList(interp, resObj, Jim_ListGetIndex(interp, tmpListObj, i / stride)); + } + Jim_SetResult(interp, resObj); + } + Jim_DecrRefCount(interp, tmpListObj); + } + else { + if ((shared = Jim_IsShared(resObj))) { + resObj = Jim_DuplicateObj(interp, resObj); + } + retCode = ListSortElements(interp, resObj, &info); + if (retCode == JIM_OK) { + Jim_SetResult(interp, resObj); + } + else if (shared) { + Jim_FreeNewObj(interp, resObj); + } } return retCode; } diff --git a/jim_tcl.txt b/jim_tcl.txt index 14cee1e..1889ac9 100644 --- a/jim_tcl.txt +++ b/jim_tcl.txt @@ -61,6 +61,9 @@ Changes since 0.80 4. `loop` can now omit the start value 5. Add the `xtrace` command for execution trace support 6. Add `history keep` +7. Add support for `lsearch -index` and `lsearch -stride`, the latter per TIP 351 +8. `lsort -index` now supports multiple indices +9. Add support for `lsort -stride` Changes between 0.79 and 0.80 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -3371,35 +3374,80 @@ the list are to be matched against pattern and must have one of the values below +*-nocase*+:: Causes comparisons to be handled in a case-insensitive manner. ++*-index* 'indexList'+:: + This option is designed for use when searching within nested lists. The + 'indexList' gives a path of indices (much as might be used with + the lindex or lset commands) within each element to allow the location + of the term being matched against. + ++*-stride* 'strideLength'+:: + If this option is specified, the list is treated as consisting of + groups of 'strideLength' elements and the groups are searched by + either their first element or, if the +-index+ option is used, + by the element within each group given by the first index passed to + +-index+ (which is then ignored by +-index+). The resulting + index always points to the first element in a group. + :: + The list length must be an integer multiple of 'strideLength', which + in turn must be at least 1. A 'strideLength' of 1 is the default and + indicates no grouping. + lsort ~~~~~ -+*lsort* ?*-index* 'listindex'? ?*-nocase|-integer|-real|-command* 'cmdname'? ?*-unique*? ?*-decreasing*|*-increasing*? 'list'+ ++*lsort* '?options? 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. -If +-nocase+ is specified, comparisons are case-insensitive. - -If +-integer+ is specified, numeric sorting is used. - -If +-real+ is specified, floating point number sorting is used. +Note that only one sort type may be selected with +-integer+, +-real+, +-nocase+ or +-command+ +with last option being used. -If +-command 'cmdname'+ is specified, +'cmdname'+ is treated as a command -name. For each comparison, +'cmdname $value1 $value2+' is called which -should compare the values and return an integer less than, equal -to, or greater than zero if the +'$value1'+ is to be considered less -than, equal to, or greater than +'$value2'+, respectively. ++*-integer*+:: + Sort using numeric (integer) comparison. -If +-decreasing+ is specified, the resulting list is in the opposite -order to what it would be otherwise. +-increasing+ is the default. ++*-real*+:: + Sort using floating point comparison. -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. ++*-nocase*+:: + Sort using using string comparison without regard for case. -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+. ++*-command* 'cmdname'+:: + +'cmdname'+ is treated as a command name. For each comparison, + +'cmdname $value1 $value2+' is called which + should compare the values and return an integer less than, equal + to, or greater than zero if the +'$value1'+ is to be considered less + than, equal to, or greater than +'$value2'+, respectively. + ++*-increasing*+:: + The resulting list is in ascending order, from smallest/lowest to largest/highest. + This is the default and does not need to be specified. + ++*-decreasing*+:: + The resulting list is in the opposite order to what it would be otherwise. + ++*-unique*+:: + 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. + ++*-index* 'indexList'+:: + This option is designed for use when sorting nested lists. The + 'indexList' gives a path of indices (much as might be used with + the lindex or lset commands) within each element to specify the + value to be used for comparison. + ++*-stride* 'strideLength'+:: + If this option is specified, the list is treated as consisting of + groups of 'strideLength' elements and the groups are sorted by + either their first element or, if the +-index+ option is used, + by the element within each group given by the first index passed to + +-index+ (which is then ignored by +-index+). The resulting list + is once again a flat list. + :: + The list length must be an integer multiple of 'strideLength', which + in turn must be at least 2. defer ~~~~~ diff --git a/tests/lsearch.test b/tests/lsearch.test index ff1342a..f8aa08d 100644 --- a/tests/lsearch.test +++ b/tests/lsearch.test @@ -187,4 +187,117 @@ test lsearch-6.10 {lsearch -not -bool -all -nocase} jim { lsearch -not -bool -glob -all -nocase {a1 a2 b1 b2 a3 b3} B* } {1 1 0 0 1 0} +test lsearch-17.1 {lsearch -index option, basic functionality} { + lsearch -index 1 {{a c} {a b} {a a}} a +} 2 +test lsearch-17.2 {lsearch -index option, basic functionality} { + lsearch -index 1 -exact {{a c} {a b} {a a}} a +} 2 +test lsearch-17.3 {lsearch -index option, basic functionality} { + lsearch -index 1 -glob {{ab cb} {ab bb} {ab ab}} b* +} 1 +test lsearch-17.4 {lsearch -index option, basic functionality} { + lsearch -index 1 -regexp {{ab cb} {ab bb} {ab ab}} {[cb]b} +} 0 +test lsearch-17.5 {lsearch -index option, basic functionality} { + lsearch -all -index 0 -exact {{a c} {a b} {d a}} a +} {0 1} +test lsearch-17.6 {lsearch -index option, basic functionality} { + lsearch -all -index 1 -glob {{ab cb} {ab bb} {db bx}} b* +} {1 2} +test lsearch-17.7 {lsearch -index option, basic functionality} { + lsearch -all -index 1 -regexp {{ab cb} {ab bb} {ab ab}} {[cb]b} +} {0 1} +test lsearch-17.8 {lsearch -index option, empty argument} { + lsearch -index {} a a +} 0 +test lsearch-17.9 {lsearch -index option, empty argument} { + lsearch -index {} a a +} [lsearch a a] +test lsearch-17.10 {lsearch -index option, empty argument} { + lsearch -index {} [list \{] \{ +} 0 +test lsearch-17.11 {lsearch -index option, empty argument} { + lsearch -index {} [list \{] \{ +} [lsearch [list \{] \{] +test lsearch-17.12 {lsearch -index option, encoding aliasing} -body { + lsearch -index -2 a a +} -returnCodes error -result {index "-2" out of range} +test lsearch-17.13 {lsearch -index option, encoding aliasing} -body { + lsearch -index -1-1 a a +} -returnCodes error -result {index "-1-1" out of range} +test lsearch-17.14 {lsearch -index option, encoding aliasing} -body { + lsearch -index end--1 a a +} -returnCodes error -result {index "end--1" out of range} +test lsearch-17.15 {lsearch -index option, encoding aliasing} -body { + lsearch -index end+1 a a +} -returnCodes error -result {index "end+1" out of range} +test lsearch-17.16 {lsearch -index option, encoding aliasing} -body { + lsearch -index end+2 a a +} -returnCodes error -result {index "end+2" out of range} + +test lsearch-20.1 {lsearch -index option, index larger than sublists} -body { + lsearch -index 2 {{a c} {a b} {a a}} a +} -returnCodes error -result {element 2 missing from sublist "a c"} +test lsearch-20.2 {lsearch -index option, malformed index} -body { + lsearch -index foo {{a c} {a b} {a a}} a +} -returnCodes error -match glob -result {bad index *} + +test lsearch-23.1 {lsearch -stride option, errors} -body { + lsearch -stride {a b} a +} -returnCodes error -match glob -result {*} +test lsearch-23.2 {lsearch -stride option, errors} -body { + lsearch -stride 0 {a b} a +} -returnCodes error -result {stride length must be at least 1} +test lsearch-23.3 {lsearch -stride option, errors} -body { + lsearch -stride 2 {a b c} a +} -returnCodes error -result {list size must be a multiple of the stride length} +test lsearch-23.4 {lsearch -stride option, errors} -body { + lsearch -stride 5 {a b c} a +} -returnCodes error -result {list size must be a multiple of the stride length} +test lsearch-23.5 {lsearch -stride option, errors} -body { + # Stride equal to length is ok + lsearch -stride 3 {a b c} a +} -result 0 + +test lsearch-24.1 {lsearch -stride option} -body { + lsearch -stride 2 {a b c d e f g h} d +} -result -1 +test lsearch-24.2 {lsearch -stride option} -body { + lsearch -stride 2 {a b c d e f g h} e +} -result 4 +test lsearch-24.3 {lsearch -stride option} -body { + lsearch -stride 3 {a b c d e f g h i} e +} -result -1 +test lsearch-24.4 {lsearch -stride option} -body { + # Result points first in group + lsearch -stride 3 -index 1 {a b c d e f g h i} e +} -result 3 +test lsearch-24.5 {lsearch -stride option} -body { + lsearch -inline -stride 2 {a b c d e f g h} d +} -result {} +test lsearch-24.6 {lsearch -stride option} -body { + # Inline result is a "single element" strided list + lsearch -inline -stride 2 {a b c d e f g h} e +} -result "e f" +test lsearch-24.7 {lsearch -stride option} -body { + lsearch -inline -stride 3 {a b c d e f g h i} e +} -result {} +test lsearch-24.8 {lsearch -stride option} -body { + lsearch -inline -stride 3 -index 1 {a b c d e f g h i} e +} -result "d e f" +test lsearch-24.9 {lsearch -stride option} -body { + lsearch -all -inline -stride 3 -index 1 {a b c d e f g e i} e +} -result "d e f g e i" +test lsearch-24.10 {lsearch -stride option} -body { + lsearch -all -inline -stride 3 -index 0 {a b c d e f a e i} a +} -result "a b c a e i" +test lsearch-24.11 {lsearch -stride option} -body { + # Stride 1 is same as no stride + lsearch -stride 1 {a b c d e f g h} d +} -result 3 +test lsearch-24.12 {lsearch -stride -index with missing elements} -body { + lsearch -stride 1 -index {1 1} {a b c} c +} -returnCodes error -result {element 1 missing from sublist "a"} + testreport diff --git a/tests/lsort.test b/tests/lsort.test index dd5a019..5297568 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, or -unique}} +} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -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 \{} @@ -131,12 +131,12 @@ test lsort-3.1 {SortCompare procedure, skip comparisons after error} { test lsort-3.2 {lsort -real, returning indices} { lsort -decreasing -real {1.2 34.5 34.5 5.6} } {34.5 34.5 5.6 1.2} -test lsort-3.3 {SortCompare procedure, -index option} jim { - list [catch {lsort -integer -index 2 {{20 10} {15 30 40}}} msg] $msg -} {1 {list index out of range}} -test lsort-3.5 {SortCompare procedure, -index option} jim { - list [catch {lsort -integer -index 2 {{20 10 13} {15}}} msg] $msg -} {1 {list index out of range}} +test lsort-3.3 {SortCompare procedure, -index option} -body { + lsort -integer -index 2 {{20 10} {15 30 40}} +} -returnCodes error -result {element 2 missing from sublist "20 10"} +test lsort-3.5 {SortCompare procedure, -index option} -body { + lsort -integer -index 2 {{20 10 13} {15}} +} -returnCodes error -result {index "2" out of range} test lsort-3.6 {SortCompare procedure, -index option} { lsort -integer -index 2 {{1 15 30} {2 5 25} {3 25 20}} } {{3 25 20} {2 5 25} {1 15 30}} @@ -202,12 +202,40 @@ test lsort-3.22 {lsort, unique sort with index} { set vallist } {0 4 5} -test lsort-4.26 {DefaultCompare procedure, signed characters} utf8 { - lsort [list "abc\u80" "abc"] -} [list "abc" "abc\u80"] test lsort-5.1 "Sort case insensitive" { lsort -nocase {ba aB aa ce} } {aa aB ba ce} +test cmdIL-1.30 {Tcl_LsortObjCmd procedure, -stride option} { + lsort -stride 2 {f e d c b a} +} {b a d c f e} +test cmdIL-1.31 {Tcl_LsortObjCmd procedure, -stride option} { + lsort -stride 3 {f e d c b a} +} {c b a f e d} +test cmdIL-1.32 {lsort -stride errors} -returnCodes error -body { + lsort -stride foo bar +} -result {expected integer but got "foo"} +test cmdIL-1.33 {lsort -stride errors} -returnCodes error -body { + lsort -stride 1 bar +} -result {stride length must be at least 2} +test cmdIL-1.34 {lsort -stride errors} -returnCodes error -body { + lsort -stride 2 {a b c} +} -result {list size must be a multiple of the stride length} +test cmdIL-1.35 {lsort -stride errors} -returnCodes error -body { + lsort -stride 2 -index 3 {a b c d} +} -match glob -result {*} +test cmdIL-1.36 {lsort -stride and -index: Bug 2918962} { + lsort -stride 2 -index {0 1} { + {{c o d e} 54321} {{b l a h} 94729} + {{b i g} 12345} {{d e m o} 34512} + } +} {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321} {{b l a h} 94729}} +test cmdIL-1.41 {lsort -stride and -index} -body { + lsort -stride 2 -index -2 {a 2 b 1} +} -returnCodes error -result {index "-2" out of range} +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} + testreport |