diff options
Diffstat (limited to 'generic/tclCmdIL.c')
| -rw-r--r-- | generic/tclCmdIL.c | 394 |
1 files changed, 252 insertions, 142 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index f7cdf29..405245a 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.41 2002/02/15 14:28:48 dkf Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.42 2002/03/06 11:28:08 dkf Exp $ */ #include "tclInt.h" @@ -2767,22 +2767,24 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) char *bytes, *patternBytes; int i, match, mode, index, result, listc, length, elemLen; int dataType, isIncreasing, lower, upper, patInt, objInt; + int offset, allMatches, inlineReturn, negatedMatch; double patDouble, objDouble; - Tcl_Obj *patObj, **listv; + Tcl_Obj *patObj, **listv, *listPtr, *startPtr; static CONST char *options[] = { - "-ascii", "-decreasing", "-dictionary", "-exact", "-increasing", - "-integer", "-glob", "-real", "-regexp", "-sorted", NULL + "-all", "-ascii", "-decreasing", "-dictionary", + "-exact", "-glob", "-increasing", "-inline", + "-integer", "-not", "-real", "-regexp", + "-sorted", "-start", NULL }; enum options { - LSEARCH_ASCII, LSEARCH_DECREASING, LSEARCH_DICTIONARY, LSEARCH_EXACT, - LSEARCH_INCREASING, LSEARCH_INTEGER, LSEARCH_GLOB, - LSEARCH_REAL, LSEARCH_REGEXP, LSEARCH_SORTED + LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_DECREASING, LSEARCH_DICTIONARY, + LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING, LSEARCH_INLINE, + LSEARCH_INTEGER, LSEARCH_NOT, LSEARCH_REAL, LSEARCH_REGEXP, + LSEARCH_SORTED, LSEARCH_START }; - enum datatypes { ASCII, DICTIONARY, INTEGER, REAL }; - enum modes { EXACT, GLOB, REGEXP, SORTED }; @@ -2790,48 +2792,93 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) mode = GLOB; dataType = ASCII; isIncreasing = 1; - + allMatches = 0; + inlineReturn = 0; + negatedMatch = 0; + listPtr = NULL; + startPtr = NULL; + offset = 0; + if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? list pattern"); return TCL_ERROR; } - + for (i = 1; i < objc-2; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) != TCL_OK) { + if (startPtr) { + Tcl_DecrRefCount(startPtr); + } return TCL_ERROR; } switch ((enum options) index) { - case LSEARCH_ASCII: /* -ascii */ - dataType = ASCII; - break; - case LSEARCH_DECREASING: /* -decreasing */ - isIncreasing = 0; - break; - case LSEARCH_DICTIONARY: /* -dictionary */ - dataType = DICTIONARY; - break; - case LSEARCH_EXACT: /* -increasing */ - mode = EXACT; - break; - case LSEARCH_INCREASING: /* -increasing */ - isIncreasing = 1; - break; - case LSEARCH_INTEGER: /* -integer */ - dataType = INTEGER; - break; - case LSEARCH_GLOB: /* -glob */ - mode = GLOB; - break; - case LSEARCH_REAL: /* -real */ - dataType = REAL; - break; - case LSEARCH_REGEXP: /* -regexp */ - mode = REGEXP; - break; - case LSEARCH_SORTED: /* -sorted */ - mode = SORTED; - break; + case LSEARCH_ALL: /* -all */ + allMatches = 1; + break; + case LSEARCH_ASCII: /* -ascii */ + dataType = ASCII; + break; + case LSEARCH_DECREASING: /* -decreasing */ + isIncreasing = 0; + break; + case LSEARCH_DICTIONARY: /* -dictionary */ + dataType = DICTIONARY; + break; + case LSEARCH_EXACT: /* -increasing */ + mode = EXACT; + break; + case LSEARCH_GLOB: /* -glob */ + mode = GLOB; + break; + case LSEARCH_INCREASING: /* -increasing */ + isIncreasing = 1; + break; + case LSEARCH_INLINE: /* -inline */ + inlineReturn = 1; + break; + case LSEARCH_INTEGER: /* -integer */ + dataType = INTEGER; + break; + case LSEARCH_NOT: /* -not */ + negatedMatch = 1; + break; + case LSEARCH_REAL: /* -real */ + dataType = REAL; + break; + case LSEARCH_REGEXP: /* -regexp */ + mode = REGEXP; + break; + case LSEARCH_SORTED: /* -sorted */ + mode = SORTED; + break; + case LSEARCH_START: /* -start */ + /* + * If there was a previous -start option, release its saved + * index because it will either be replaced or there will be + * an error. + */ + if (startPtr) { + Tcl_DecrRefCount(startPtr); + } + if (i > objc-4) { + Tcl_AppendResult(interp, "missing starting index", NULL); + return TCL_ERROR; + } + i++; + if (objv[i] == objv[objc - 2]) { + /* + * Take copy to prevent shimmering problems. Note + * that it does not matter if the index obj is also a + * component of the list being searched. We only need + * to copy where the list and the index are + * one-and-the-same. + */ + startPtr = Tcl_DuplicateObj(objv[i]); + } else { + startPtr = objv[i]; + Tcl_IncrRefCount(startPtr); + } } } @@ -2842,29 +2889,48 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) result = Tcl_ListObjGetElements(interp, objv[objc - 2], &listc, &listv); if (result != TCL_OK) { + if (startPtr) { + Tcl_DecrRefCount(startPtr); + } return result; } + /* + * Get the user-specified start offset. + */ + if (startPtr) { + result = TclGetIntForIndex(interp, startPtr, listc-1, &offset); + Tcl_DecrRefCount(startPtr); + if (result != TCL_OK) { + return result; + } + if (offset < 0) { + offset = 0; + } else if (offset > listc-1) { + offset = listc-1; + } + } + patObj = objv[objc - 1]; patternBytes = NULL; if ((enum modes) mode == EXACT || (enum modes) mode == SORTED) { switch ((enum datatypes) dataType) { - case ASCII: - case DICTIONARY: - patternBytes = Tcl_GetStringFromObj(patObj, &length); - break; - case INTEGER: - result = Tcl_GetIntFromObj(interp, patObj, &patInt); - if (result != TCL_OK) { - return result; - } - break; - case REAL: - result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble); - if (result != TCL_OK) { - return result; - } - break; + case ASCII: + case DICTIONARY: + patternBytes = Tcl_GetStringFromObj(patObj, &length); + break; + case INTEGER: + result = Tcl_GetIntFromObj(interp, patObj, &patInt); + if (result != TCL_OK) { + return result; + } + break; + case REAL: + result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble); + if (result != TCL_OK) { + return result; + } + break; } } else { patternBytes = Tcl_GetStringFromObj(patObj, &length); @@ -2877,52 +2943,54 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) */ index = -1; match = 0; - if ((enum modes) mode == SORTED) { - /* If the data is sorted, we can do a more intelligent search */ - lower = -1; + + if ((enum modes) mode == SORTED && !allMatches && !negatedMatch) { + /* + * If the data is sorted, we can do a more intelligent search. + * Note that there is no point in being smart when -all was + * specified; in that case, we have to look at all items anyway, + * and there is no sense in doing this when the match sense is + * inverted. + */ + lower = offset - 1; upper = listc; while (lower + 1 != upper) { i = (lower + upper)/2; switch ((enum datatypes) dataType) { - case ASCII: { - bytes = Tcl_GetString(listv[i]); - match = strcmp(patternBytes, bytes); - break; + case ASCII: + bytes = Tcl_GetString(listv[i]); + match = strcmp(patternBytes, bytes); + break; + case DICTIONARY: + bytes = Tcl_GetString(listv[i]); + match = DictionaryCompare(patternBytes, bytes); + break; + case INTEGER: + result = Tcl_GetIntFromObj(interp, listv[i], &objInt); + if (result != TCL_OK) { + return result; } - case DICTIONARY: { - bytes = Tcl_GetString(listv[i]); - match = DictionaryCompare(patternBytes, bytes); - break; + if (patInt == objInt) { + match = 0; + } else if (patInt < objInt) { + match = -1; + } else { + match = 1; } - case INTEGER: { - result = Tcl_GetIntFromObj(interp, listv[i], &objInt); - if (result != TCL_OK) { - return result; - } - if (patInt == objInt) { - match = 0; - } else if (patInt < objInt) { - match = -1; - } else { - match = 1; - } - break; + break; + case REAL: + result = Tcl_GetDoubleFromObj(interp, listv[i], &objDouble); + if (result != TCL_OK) { + return result; } - case REAL: { - result = Tcl_GetDoubleFromObj(interp, listv[i], - &objDouble); - if (result != TCL_OK) { - return result; - } - if (patDouble == objDouble) { - match = 0; - } else if (patDouble < objDouble) { - match = -1; - } else { - match = 1; - } - break; + if (patDouble == objDouble) { + match = 0; + } else if (patDouble < objDouble) { + match = -1; + } else { + match = 1; } + break; } if (match == 0) { /* @@ -2953,68 +3021,110 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) } } } + } else { - for (i = 0; i < listc; i++) { + /* + * We need to do a linear search, because (at least one) of: + * - our matcher can only tell equal vs. not equal + * - our matching sense is negated + * - we're building a list of all matched items + */ + if (allMatches) { + listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); + } + for (i = offset; i < listc; i++) { match = 0; switch ((enum modes) mode) { - case SORTED: - case EXACT: { - switch ((enum datatypes) dataType) { - case ASCII: { - bytes = Tcl_GetStringFromObj(listv[i], &elemLen); - if (length == elemLen) { - match = (memcmp(bytes, patternBytes, - (size_t) length) == 0); - } - break; - } - case DICTIONARY: { - bytes = Tcl_GetString(listv[i]); - match = - (DictionaryCompare(bytes, patternBytes) == 0); - break; - } - case INTEGER: { - result = Tcl_GetIntFromObj(interp, listv[i], - &objInt); - if (result != TCL_OK) { - return result; - } - match = (objInt == patInt); - break; - } - case REAL: { - result = Tcl_GetDoubleFromObj(interp, listv[i], - &objDouble); - if (result != TCL_OK) { - return result; - } - match = (objDouble == patDouble); - break; + case SORTED: + case EXACT: + switch ((enum datatypes) dataType) { + case ASCII: + bytes = Tcl_GetStringFromObj(listv[i], &elemLen); + if (length == elemLen) { + match = (memcmp(bytes, patternBytes, + (size_t) length) == 0); + } + break; + case DICTIONARY: + bytes = Tcl_GetString(listv[i]); + match = (DictionaryCompare(bytes, patternBytes) == 0); + break; + case INTEGER: + result = Tcl_GetIntFromObj(interp, listv[i], &objInt); + if (result != TCL_OK) { + if (listPtr) { + Tcl_DecrRefCount(listPtr); } + return result; } + match = (objInt == patInt); break; - } - case GLOB: { - match = Tcl_StringMatch(Tcl_GetString(listv[i]), - patternBytes); + case REAL: + result = Tcl_GetDoubleFromObj(interp, listv[i], + &objDouble); + if (result != TCL_OK) { + if (listPtr) { + Tcl_DecrRefCount(listPtr); + } + return result; + } + match = (objDouble == patDouble); break; } - case REGEXP: { - match = Tcl_RegExpMatchObj(interp, listv[i], patObj); - if (match < 0) { - return TCL_ERROR; + break; + case GLOB: + match = Tcl_StringMatch(Tcl_GetString(listv[i]), + patternBytes); + break; + case REGEXP: + match = Tcl_RegExpMatchObj(interp, listv[i], patObj); + if (match < 0) { + if (listPtr) { + Tcl_DecrRefCount(listPtr); } - break; + return TCL_ERROR; } + break; + } + /* + * Invert match condition for -not + */ + if (negatedMatch) { + match = !match; } if (match != 0) { - index = i; - break; + if (!allMatches) { + index = i; + break; + } else if (inlineReturn) { + /* + * Note that these appends are not expected to fail. + */ + Tcl_ListObjAppendElement(interp, listPtr, listv[i]); + } else { + Tcl_ListObjAppendElement(interp, listPtr, + Tcl_NewIntObj(i)); + } } } } - Tcl_SetIntObj(Tcl_GetObjResult(interp), index); + + /* + * Return everything or a single value. + */ + if (allMatches) { + Tcl_SetObjResult(interp, listPtr); + } else if (!inlineReturn) { + Tcl_SetIntObj(Tcl_GetObjResult(interp), index); + } else if (index < 0) { + /* + * Is this superfluous? The result should be a blank object + * by default... + */ + Tcl_SetObjResult(interp, Tcl_NewObj()); + } else { + Tcl_SetObjResult(interp, listv[index]); + } return TCL_OK; } |