diff options
author | dgp <dgp@users.sourceforge.net> | 2005-04-29 20:49:39 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2005-04-29 20:49:39 (GMT) |
commit | 8b1602650fa95940adc93df6e9c477d12de32664 (patch) | |
tree | 55c506247b96b5a5df5bcc7f1aeb3f66cbc3cdb8 /generic | |
parent | 0ab970b22ad15d0f56a3d5a53461daedf8bfc5ef (diff) | |
download | tcl-8b1602650fa95940adc93df6e9c477d12de32664.zip tcl-8b1602650fa95940adc93df6e9c477d12de32664.tar.gz tcl-8b1602650fa95940adc93df6e9c477d12de32664.tar.bz2 |
TIP#176 IMPLEMENTATION [Patch 1165695]
* generic/tclUtil.c: Extended TclGetIntForIndex to recognize
index formats including end+integer and integer+/-integer.
* generic/tclCmdMZ.c: Extended the -start switch of [regexp]
and [regsub] to accept all index formats known by TclGetIntForIndex.
* doc/lindex.n: Updated docs to note new index formats.
* doc/linsert.n:
* doc/lrange.n:
* doc/lreplace.n:
* doc/lsearch.n:
* doc/lset.n:
* doc/lsort.n:
* doc/regexp.n:
* doc/regsub.n:
* doc/string.n:
* tests/cmdIL.test: Updated tests.
* tests/compile.test:
* tests/lindex.test:
* tests/linsert.test:
* tests/lrange.test:
* tests/lreplace.test:
* tests/lsearch.test:
* tests/lset.test:
* tests/regexp.test:
* tests/regexpComp.test:
* tests/string.test:
* tests/stringComp.test:
* tests/util.test:
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclCmdMZ.c | 63 | ||||
-rw-r--r-- | generic/tclUtil.c | 68 |
2 files changed, 104 insertions, 27 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index e85e0ea..18da3f4 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.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: tclCmdMZ.c,v 1.116 2005/04/08 10:42:51 dkf Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.117 2005/04/29 20:49:43 dgp Exp $ */ #include "tclInt.h" @@ -90,7 +90,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) int i, indices, match, about, offset, all, doinline, numMatchesSaved; int cflags, eflags, stringLength; Tcl_RegExp regExpr; - Tcl_Obj *objPtr, *resultPtr = NULL; + Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL; Tcl_RegExpInfo info; static CONST char *options[] = { "-all", "-about", "-indices", "-inline", @@ -121,7 +121,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) } if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT, &index) != TCL_OK) { - return TCL_ERROR; + goto optionError; } switch ((enum options) index) { case REGEXP_ALL: { @@ -161,15 +161,18 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) break; } case REGEXP_START: { + int temp; if (++i >= objc) { goto endOfForLoop; } - if (Tcl_GetIntFromObj(interp, objv[i], &offset) != TCL_OK) { - return TCL_ERROR; + if (TclGetIntForIndex(interp, objv[i], 0, &temp) != TCL_OK) { + goto optionError; } - if (offset < 0) { - offset = 0; + if (startIndex) { + Tcl_DecrRefCount(startIndex); } + startIndex = objv[i]; + Tcl_IncrRefCount(startIndex); break; } case REGEXP_LAST: { @@ -183,7 +186,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) if ((objc - i) < (2 - about)) { Tcl_WrongNumArgs(interp, 1, objv, "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"); - return TCL_ERROR; + goto optionError; } objc -= i; objv += i; @@ -194,7 +197,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) */ Tcl_AppendResult(interp, "regexp match variables not allowed", " when using -inline", (char *) NULL); - return TCL_ERROR; + goto optionError; } /* @@ -203,6 +206,10 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) if (about) { regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); if ((regExpr == NULL) || (TclRegAbout(interp, regExpr) < 0)) { +optionError: + if (startIndex) { + Tcl_DecrRefCount(startIndex); + } return TCL_ERROR; } return TCL_OK; @@ -216,6 +223,14 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) objPtr = objv[1]; stringLength = Tcl_GetCharLength(objPtr); + if (startIndex) { + TclGetIntForIndex(NULL, startIndex, stringLength, &offset); + Tcl_DecrRefCount(startIndex); + if (offset < 0) { + offset = 0; + } + } + regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); if (regExpr == NULL) { return TCL_ERROR; @@ -426,7 +441,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) int start, end, subStart, subEnd, match; Tcl_RegExp regExpr; Tcl_RegExpInfo info; - Tcl_Obj *resultPtr, *subPtr, *objPtr; + Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL; Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend; static CONST char *options[] = { @@ -455,7 +470,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) } if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch", TCL_EXACT, &index) != TCL_OK) { - return TCL_ERROR; + goto optionError; } switch ((enum options) index) { case REGSUB_ALL: { @@ -483,15 +498,18 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) break; } case REGSUB_START: { + int temp; if (++idx >= objc) { goto endOfForLoop; } - if (Tcl_GetIntFromObj(interp, objv[idx], &offset) != TCL_OK) { - return TCL_ERROR; + if (TclGetIntForIndex(interp, objv[idx], 0, &temp) != TCL_OK) { + goto optionError; } - if (offset < 0) { - offset = 0; + if (startIndex) { + Tcl_DecrRefCount(startIndex); } + startIndex = objv[idx]; + Tcl_IncrRefCount(startIndex); break; } case REGSUB_LAST: { @@ -504,12 +522,25 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) if (objc-idx < 3 || objc-idx > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?switches? exp string subSpec ?varName?"); - return TCL_ERROR; +optionError: + if (startIndex) { + Tcl_DecrRefCount(startIndex); + } + return TCL_ERROR; } objc -= idx; objv += idx; + if (startIndex) { + int stringLength = Tcl_GetCharLength(objv[1]); + TclGetIntForIndex(NULL, startIndex, stringLength, &offset); + Tcl_DecrRefCount(startIndex); + if (offset < 0) { + offset = 0; + } + } + if (all && (offset == 0) && (strpbrk(TclGetString(objv[2]), "&\\") == NULL) && (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) { diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 16cee4b..1541216 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUtil.c,v 1.55 2005/04/12 20:28:48 dgp Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.56 2005/04/29 20:49:44 dgp Exp $ */ #include "tclInt.h" @@ -2269,15 +2269,14 @@ TclLooksLikeInt(bytes, length) * * This procedure returns an integer corresponding to the list index * held in a Tcl object. The Tcl object's value is expected to be - * either an integer or a string of the form "end([+-]integer)?". + * in the format integer([+-]integer)? or the format end([+-]integer)?. * * Results: * The return value is normally TCL_OK, which means that the index was * successfully stored into the location referenced by "indexPtr". If * the Tcl object referenced by "objPtr" has the value "end", the - * value stored is "endValue". If "objPtr"s values is not of the form - * "end([+-]integer)?" and - * can not be converted to an integer, TCL_ERROR is returned and, if + * value stored is "endValue". If "objPtr"s values is not of one + * of the expected formats, TCL_ERROR is returned and, if * "interp" is non-NULL, an error message is left in the interpreter's * result object. * @@ -2313,10 +2312,51 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr) *indexPtr = endValue + objPtr->internalRep.longValue; } else { + int opIdx, length; + char *bytes = Tcl_GetStringFromObj(objPtr, &length); + char *p = bytes; + + while (length && isspace(UCHAR(*p))) { /* INTL: ISO space. */ + length--; p++; + } + if (length == 0) { + goto parseError; + } + if ((*p == '+') || (*p == '-')) { + p++; length--; + } + opIdx = TclParseInteger(p, length) + (int) (p-bytes); + if (opIdx) { + int code, first, second; + char savedOp = bytes[opIdx]; + if ((savedOp != '+') && (savedOp != '-')) { + goto parseError; + } + if (isspace(UCHAR(bytes[opIdx+1]))) { + goto parseError; + } + bytes[opIdx] = '\0'; + code = Tcl_GetInt(interp, bytes, &first); + bytes[opIdx] = savedOp; + if (code == TCL_ERROR) { + goto parseError; + } + if (TCL_ERROR == Tcl_GetInt(interp, bytes+opIdx+1, &second)) { + goto parseError; + } + if (savedOp == '+') { + *indexPtr = first + second; + } else { + *indexPtr = first - second; + } + return TCL_OK; + } + /* * Report a parse error. */ +parseError: if (interp != NULL) { char *bytes = Tcl_GetString(objPtr); /* @@ -2326,7 +2366,8 @@ TclGetIntForIndex(interp, objPtr, endValue, indexPtr) */ Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad index \"", bytes, - "\": must be integer or end?-integer?", (char *) NULL); + "\": must be integer?[+-]integer? or end?[+-]integer?", + (char *) NULL); if (!strncmp(bytes, "end-", 3)) { bytes += 3; } @@ -2383,7 +2424,7 @@ UpdateStringOfEndOffset(objPtr) * * SetEndOffsetFromAny -- * - * Look for a string of the form "end-offset" and convert it + * Look for a string of the form "end[+-]offset" and convert it * to an internal representation holding the offset. * * Results: @@ -2419,7 +2460,7 @@ SetEndOffsetFromAny(interp, objPtr) if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad index \"", bytes, - "\": must be end?-integer?", (char*) NULL); + "\": must be end?[+-]integer?", (char*) NULL); } return TCL_ERROR; } @@ -2428,15 +2469,20 @@ SetEndOffsetFromAny(interp, objPtr) if (length <= 3) { offset = 0; - } else if ((length > 4) && (bytes[3] == '-')) { + } else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) { /* * This is our limited string expression evaluator. Pass everything * after "end-" to Tcl_GetInt, then reverse for offset. */ + if (isspace(UCHAR(bytes[4]))) { + return TCL_ERROR; + } if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) { return TCL_ERROR; } - offset = -offset; + if (bytes[3] == '-') { + offset = -offset; + } } else { /* * Conversion failed. Report the error. @@ -2444,7 +2490,7 @@ SetEndOffsetFromAny(interp, objPtr) if (interp != NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "bad index \"", bytes, - "\": must be integer or end?-integer?", (char *) NULL); + "\": must be end?[+-]integer?", (char *) NULL); } return TCL_ERROR; } |