diff options
author | dgp <dgp@users.sourceforge.net> | 2018-03-15 15:34:00 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2018-03-15 15:34:00 (GMT) |
commit | 7435702d63be37049674d56f6baef6012cb89378 (patch) | |
tree | cee1e121a10cd162f4f804cd703b33844e724d29 /generic/tclCmdIL.c | |
parent | 651697f7cd746dded1a031d4217376000a176037 (diff) | |
parent | aa199edba612a516e6309290fb6dc4442a49a5ee (diff) | |
download | tcl-7435702d63be37049674d56f6baef6012cb89378.zip tcl-7435702d63be37049674d56f6baef6012cb89378.tar.gz tcl-7435702d63be37049674d56f6baef6012cb89378.tar.bz2 |
merge 8.7
Diffstat (limited to 'generic/tclCmdIL.c')
-rw-r--r-- | generic/tclCmdIL.c | 275 |
1 files changed, 185 insertions, 90 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 001b62d..3d058a4 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -64,8 +64,9 @@ typedef struct SortInfo { * SORTMODE_COMMAND. Pre-initialized to hold * base of command. */ int *indexv; /* If the -index option was specified, this - * holds the indexes contained in the list - * supplied as an argument to that option. + * holds an encoding of the indexes contained + * in the list supplied as an argument to + * that option. * NULL if no indexes supplied, and points to * singleIndex field when only one * supplied. */ @@ -93,14 +94,6 @@ typedef struct SortInfo { #define SORTMODE_ASCII_NC 8 /* - * 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: */ @@ -2160,7 +2153,7 @@ Tcl_JoinObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - int listLen; + int length, listLen; Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs; if ((objc < 2) || (objc > 3)) { @@ -2191,9 +2184,9 @@ Tcl_JoinObjCmd( joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2]; Tcl_IncrRefCount(joinObjPtr); - if (Tcl_GetCharLength(joinObjPtr) == 0) { - TclStringCatObjv(interp, /* inPlace */ 0, listLen, elemPtrs, - &resObjPtr); + (void) Tcl_GetStringFromObj(joinObjPtr, &length); + if (length == 0) { + resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0); } else { int i; @@ -2745,7 +2738,7 @@ Tcl_LreplaceObjCmd( * (to allow for replacing the last elem). */ - if ((first > listLen) && (listLen > 0)) { + if ((first >= listLen) && (listLen > 0)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "list doesn't contain element %s", TclGetString(objv[2]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX", @@ -2896,8 +2889,9 @@ Tcl_LsearchObjCmd( Tcl_Obj *const objv[]) /* Argument values. */ { const char *bytes, *patternBytes; - int i, match, index, result, listc, length, elemLen, bisect; - int dataType, isIncreasing, lower, upper, offset; + int i, match, index, result=TCL_OK, listc, length, elemLen, bisect; + int allocatedIndexVector = 0; + int dataType, isIncreasing, lower, upper, start, groupSize, groupOffset; Tcl_WideInt patWide, objWide; int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase; double patDouble, objDouble; @@ -2909,7 +2903,7 @@ Tcl_LsearchObjCmd( "-all", "-ascii", "-bisect", "-decreasing", "-dictionary", "-exact", "-glob", "-increasing", "-index", "-inline", "-integer", "-nocase", "-not", - "-real", "-regexp", "-sorted", "-start", + "-real", "-regexp", "-sorted", "-start", "-stride", "-subindices", NULL }; enum options { @@ -2917,7 +2911,7 @@ Tcl_LsearchObjCmd( LSEARCH_DICTIONARY, LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING, LSEARCH_INDEX, LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOCASE, LSEARCH_NOT, LSEARCH_REAL, LSEARCH_REGEXP, LSEARCH_SORTED, - LSEARCH_START, LSEARCH_SUBINDICES + LSEARCH_START, LSEARCH_STRIDE, LSEARCH_SUBINDICES }; enum datatypes { ASCII, DICTIONARY, INTEGER, REAL @@ -2937,7 +2931,9 @@ Tcl_LsearchObjCmd( bisect = 0; listPtr = NULL; startPtr = NULL; - offset = 0; + groupSize = 1; + groupOffset = 0; + start = 0; noCase = 0; sortInfo.compareCmdPtr = NULL; sortInfo.isIncreasing = 1; @@ -2955,9 +2951,6 @@ Tcl_LsearchObjCmd( for (i = 1; i < objc-2; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) != TCL_OK) { - if (startPtr != NULL) { - Tcl_DecrRefCount(startPtr); - } result = TCL_ERROR; goto done; } @@ -3022,6 +3015,7 @@ Tcl_LsearchObjCmd( if (startPtr != NULL) { Tcl_DecrRefCount(startPtr); + startPtr = NULL; } if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -3042,25 +3036,47 @@ Tcl_LsearchObjCmd( startPtr = Tcl_DuplicateObj(objv[i]); } else { startPtr = objv[i]; - Tcl_IncrRefCount(startPtr); } + Tcl_IncrRefCount(startPtr); + break; + case LSEARCH_STRIDE: /* -stride */ + if (i > objc-4) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "\"-stride\" option must be " + "followed by stride length", -1)); + Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); + result = TCL_ERROR; + goto done; + } + if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + if (groupSize < 1) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "stride length must be at least 1", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", + "BADSTRIDE", NULL); + result = TCL_ERROR; + goto done; + } + i++; break; case LSEARCH_INDEX: { /* -index */ Tcl_Obj **indices; int j; - if (sortInfo.indexc > 1) { + if (allocatedIndexVector) { TclStackFree(interp, sortInfo.indexv); + allocatedIndexVector = 0; } if (i > objc-4) { - if (startPtr != NULL) { - Tcl_DecrRefCount(startPtr); - } Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-index\" option must be followed by list index", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); - return TCL_ERROR; + result = TCL_ERROR; + goto done; } /* @@ -3072,10 +3088,8 @@ Tcl_LsearchObjCmd( i++; if (TclListObjGetElements(interp, objv[i], &sortInfo.indexc, &indices) != TCL_OK) { - if (startPtr != NULL) { - Tcl_DecrRefCount(startPtr); - } - return TCL_ERROR; + result = TCL_ERROR; + goto done; } switch (sortInfo.indexc) { case 0: @@ -3087,6 +3101,8 @@ Tcl_LsearchObjCmd( default: sortInfo.indexv = TclStackAlloc(interp, sizeof(int) * sortInfo.indexc); + allocatedIndexVector = 1; /* Cannot use indexc field, as it + * might be decreased by 1 later. */ } /* @@ -3096,13 +3112,26 @@ Tcl_LsearchObjCmd( */ for (j=0 ; j<sortInfo.indexc ; j++) { - if (TclGetIntForIndexM(interp, indices[j], SORTIDX_END, - &sortInfo.indexv[j]) != TCL_OK) { + int encoded = 0; + if (TclIndexEncode(interp, indices[j], TCL_INDEX_BEFORE, + TCL_INDEX_AFTER, &encoded) != TCL_OK) { + result = TCL_ERROR; + } + if ((encoded == TCL_INDEX_BEFORE) + || (encoded == TCL_INDEX_AFTER)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "index \"%s\" cannot select an element " + "from any list", Tcl_GetString(indices[j]))); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" + "OUTOFRANGE", NULL); + result = TCL_ERROR; + } + if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (-index option item number %d)", j)); - result = TCL_ERROR; goto done; } + sortInfo.indexv[j] = encoded; } break; } @@ -3114,14 +3143,12 @@ Tcl_LsearchObjCmd( */ if (returnSubindices && sortInfo.indexc==0) { - if (startPtr != NULL) { - Tcl_DecrRefCount(startPtr); - } Tcl_SetObjResult(interp, Tcl_NewStringObj( "-subindices cannot be used without -index option", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BAD_OPTION_MIX", NULL); - return TCL_ERROR; + result = TCL_ERROR; + goto done; } if (bisect && (allMatches || negatedMatch)) { @@ -3129,7 +3156,8 @@ Tcl_LsearchObjCmd( "-bisect is not compatible with -all or -not", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BAD_OPTION_MIX", NULL); - return TCL_ERROR; + result = TCL_ERROR; + goto done; } if (mode == REGEXP) { @@ -3155,9 +3183,6 @@ Tcl_LsearchObjCmd( } if (regexp == NULL) { - if (startPtr != NULL) { - Tcl_DecrRefCount(startPtr); - } result = TCL_ERROR; goto done; } @@ -3170,24 +3195,64 @@ Tcl_LsearchObjCmd( result = TclListObjGetElements(interp, objv[objc - 2], &listc, &listv); if (result != TCL_OK) { - if (startPtr != NULL) { - Tcl_DecrRefCount(startPtr); - } goto done; } /* + * Check for sanity when grouping elements of the overall list together + * because of the -stride option. [TIP #351] + */ + + if (groupSize > 1) { + if (listc % groupSize) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "list size must be a multiple of the stride length", + -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BADSTRIDE", + NULL); + result = TCL_ERROR; + goto done; + } + if (sortInfo.indexc > 0) { + /* + * Use the first value in the list supplied to -index as the + * offset of the element within each group by which to sort. + */ + + groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1); + if (groupOffset < 0 || groupOffset >= groupSize) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "when used with \"-stride\", the leading \"-index\"" + " value must be within the group", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", + "BADINDEX", NULL); + result = TCL_ERROR; + goto done; + } + if (sortInfo.indexc == 1) { + sortInfo.indexc = 0; + sortInfo.indexv = NULL; + } else { + sortInfo.indexc--; + + for (i = 0; i < sortInfo.indexc; i++) { + sortInfo.indexv[i] = sortInfo.indexv[i+1]; + } + } + } + } + + /* * Get the user-specified start offset. */ if (startPtr) { - result = TclGetIntForIndexM(interp, startPtr, listc-1, &offset); - Tcl_DecrRefCount(startPtr); + result = TclGetIntForIndexM(interp, startPtr, listc-1, &start); if (result != TCL_OK) { goto done; } - if (offset < 0) { - offset = 0; + if (start < 0) { + start = 0; } /* @@ -3195,16 +3260,21 @@ Tcl_LsearchObjCmd( * "did not match anything at all" result straight away. [Bug 1374778] */ - if (offset > listc-1) { - if (sortInfo.indexc > 1) { - TclStackFree(interp, sortInfo.indexv); - } + if (start > listc-1) { if (allMatches || inlineReturn) { Tcl_ResetResult(interp); } else { Tcl_SetObjResult(interp, Tcl_NewIntObj(-1)); } - return TCL_OK; + goto done; + } + + /* + * If start points within a group, it points to the start of the group. + */ + + if (groupSize > 1) { + start -= (start % groupSize); } } @@ -3263,18 +3333,23 @@ Tcl_LsearchObjCmd( * sense in doing this when the match sense is inverted. */ - lower = offset - 1; + /* + * With -stride, lower, upper and i are kept as multiples of groupSize. + */ + + lower = start - groupSize; upper = listc; - while (lower + 1 != upper && sortInfo.resultCode == TCL_OK) { + while (lower + groupSize != upper && sortInfo.resultCode == TCL_OK) { i = (lower + upper)/2; + i -= i % groupSize; if (sortInfo.indexc != 0) { - itemPtr = SelectObjFromSublist(listv[i], &sortInfo); + itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo); if (sortInfo.resultCode != TCL_OK) { result = sortInfo.resultCode; goto done; } } else { - itemPtr = listv[i]; + itemPtr = listv[i+groupOffset]; } switch ((enum datatypes) dataType) { case ASCII: @@ -3363,10 +3438,10 @@ Tcl_LsearchObjCmd( if (allMatches) { listPtr = Tcl_NewListObj(0, NULL); } - for (i = offset; i < listc; i++) { + for (i = start; i < listc; i += groupSize) { match = 0; if (sortInfo.indexc != 0) { - itemPtr = SelectObjFromSublist(listv[i], &sortInfo); + itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo); if (sortInfo.resultCode != TCL_OK) { if (listPtr != NULL) { Tcl_DecrRefCount(listPtr); @@ -3375,7 +3450,7 @@ Tcl_LsearchObjCmd( goto done; } } else { - itemPtr = listv[i]; + itemPtr = listv[i+groupOffset]; } switch (mode) { @@ -3465,18 +3540,23 @@ Tcl_LsearchObjCmd( */ if (returnSubindices && (sortInfo.indexc != 0)) { - itemPtr = SelectObjFromSublist(listv[i], &sortInfo); + itemPtr = SelectObjFromSublist(listv[i+groupOffset], + &sortInfo); + Tcl_ListObjAppendElement(interp, listPtr, itemPtr); + } else if (groupSize > 1) { + Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0, + groupSize, &listv[i]); } else { itemPtr = listv[i]; + Tcl_ListObjAppendElement(interp, listPtr, itemPtr); } - Tcl_ListObjAppendElement(interp, listPtr, itemPtr); } else if (returnSubindices) { int j; - itemPtr = Tcl_NewIntObj(i); + itemPtr = Tcl_NewIntObj(i+groupOffset); for (j=0 ; j<sortInfo.indexc ; j++) { - Tcl_ListObjAppendElement(interp, itemPtr, - Tcl_NewIntObj(sortInfo.indexv[j])); + Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewIntObj( + TclIndexDecode(sortInfo.indexv[j], listc))); } Tcl_ListObjAppendElement(interp, listPtr, itemPtr); } else { @@ -3495,10 +3575,10 @@ Tcl_LsearchObjCmd( if (returnSubindices) { int j; - itemPtr = Tcl_NewIntObj(index); + itemPtr = Tcl_NewIntObj(index+groupOffset); for (j=0 ; j<sortInfo.indexc ; j++) { - Tcl_ListObjAppendElement(interp, itemPtr, - Tcl_NewIntObj(sortInfo.indexv[j])); + Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewIntObj( + TclIndexDecode(sortInfo.indexv[j], listc))); } Tcl_SetObjResult(interp, itemPtr); } else { @@ -3512,7 +3592,14 @@ Tcl_LsearchObjCmd( Tcl_SetObjResult(interp, Tcl_NewObj()); } else { - Tcl_SetObjResult(interp, listv[index]); + if (returnSubindices) { + Tcl_SetObjResult(interp, SelectObjFromSublist(listv[i+groupOffset], + &sortInfo)); + } else if (groupSize > 1) { + Tcl_SetObjResult(interp, Tcl_NewListObj(groupSize, &listv[index])); + } else { + Tcl_SetObjResult(interp, listv[index]); + } } result = TCL_OK; @@ -3521,7 +3608,10 @@ Tcl_LsearchObjCmd( */ done: - if (sortInfo.indexc > 1) { + if (startPtr != NULL) { + Tcl_DecrRefCount(startPtr); + } + if (allocatedIndexVector) { TclStackFree(interp, sortInfo.indexv); } return result; @@ -3715,7 +3805,7 @@ Tcl_LsortObjCmd( sortInfo.isIncreasing = 1; break; case LSORT_INDEX: { - int indexc, dummy; + int indexc; Tcl_Obj **indexv; if (i == objc-2) { @@ -3741,8 +3831,20 @@ Tcl_LsortObjCmd( */ for (j=0 ; j<indexc ; j++) { - if (TclGetIntForIndexM(interp, indexv[j], SORTIDX_END, - &dummy) != TCL_OK) { + int encoded = 0; + int result = TclIndexEncode(interp, indexv[j], + TCL_INDEX_BEFORE, TCL_INDEX_AFTER, &encoded); + + if ((result == TCL_OK) && ((encoded == TCL_INDEX_BEFORE) + || (encoded == TCL_INDEX_AFTER))) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "index \"%s\" cannot select an element " + "from any list", Tcl_GetString(indexv[j]))); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" + "OUTOFRANGE", NULL); + result = TCL_ERROR; + } + if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (-index option item number %d)", j)); sortInfo.resultCode = TCL_ERROR; @@ -3822,8 +3924,8 @@ Tcl_LsortObjCmd( * might be decreased by 1 later. */ } for (j=0 ; j<sortInfo.indexc ; j++) { - TclGetIntForIndexM(interp, indexv[j], SORTIDX_END, - &sortInfo.indexv[j]); + /* Prescreened values, no errors or out of range possible */ + TclIndexEncode(NULL, indexv[j], 0, 0, &sortInfo.indexv[j]); } } @@ -3894,10 +3996,7 @@ Tcl_LsortObjCmd( * offset of the element within each group by which to sort. */ - groupOffset = sortInfo.indexv[0]; - if (groupOffset <= SORTIDX_END) { - groupOffset = (groupOffset - SORTIDX_END) + groupSize - 1; - } + groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1); if (groupOffset < 0 || groupOffset >= groupSize) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "when used with \"-stride\", the leading \"-index\"" @@ -3916,6 +4015,9 @@ Tcl_LsortObjCmd( /* * Do not shrink the actual memory block used; that doesn't * work with TclStackAlloc-allocated memory. [Bug 2918962] + * + * TODO: Consider a pointer increment to replace this + * array shift. */ for (i = 0; i < sortInfo.indexc; i++) { @@ -4484,15 +4586,8 @@ SelectObjFromSublist( infoPtr->resultCode = TCL_ERROR; return NULL; } - index = infoPtr->indexv[i]; - /* - * Adjust for end-based indexing. - */ - - if (index < SORTIDX_NONE) { - index += listLen + 1; - } + index = TclIndexDecode(infoPtr->indexv[i], listLen - 1); if (Tcl_ListObjIndex(infoPtr->interp, objPtr, index, ¤tObj) != TCL_OK) { |