summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCmdMZ.c63
-rw-r--r--generic/tclUtil.c68
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;
}
generated by cgit v0.12 at 2024-11-10 04:16:51 (GMT)