summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorhobbs <hobbs>2001-09-13 23:49:56 (GMT)
committerhobbs <hobbs>2001-09-13 23:49:56 (GMT)
commit37be4afdd112e8b929bc2005e753d1df3b500065 (patch)
tree52febc2fcdf5ae70a517592874d30583efea37e5 /generic
parent298ec8a4e8fbb3d26a8c5a4e3c8b46fc4121fcc5 (diff)
downloadtcl-37be4afdd112e8b929bc2005e753d1df3b500065.zip
tcl-37be4afdd112e8b929bc2005e753d1df3b500065.tar.gz
tcl-37be4afdd112e8b929bc2005e753d1df3b500065.tar.bz2
* generic/tclCmdMZ.c (Tcl_RegsubObjCmd): had to adjust fix from
2001-08-06 to actually duplicate the objects in certain cases. This is really a place where feather would have been essential. [Bug #461322]
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCmdMZ.c42
1 files changed, 27 insertions, 15 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 108d931..66b6106 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -13,7 +13,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.44 2001/09/13 11:56:19 msofer Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.45 2001/09/13 23:49:57 hobbs Exp $
*/
#include "tclInt.h"
@@ -471,7 +471,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
int start, end, subStart, subEnd, match;
Tcl_RegExp regExpr;
Tcl_RegExpInfo info;
- Tcl_Obj *resultPtr, *varPtr, *objPtr;
+ Tcl_Obj *resultPtr, *subPtr, *objPtr;
Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend;
static char *options[] = {
@@ -553,21 +553,30 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
objv += idx;
- /*
- * Get the length of the string that we are matching before
- * getting the regexp to avoid shimmering problems.
- */
-
- objPtr = objv[1];
- wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen);
- wsubspec = Tcl_GetUnicodeFromObj(objv[2], &wsublen);
- varPtr = objv[3];
-
regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
if (regExpr == NULL) {
return TCL_ERROR;
}
+ /*
+ * Make sure to avoid problems where the objects are shared. This
+ * can cause RegExpObj <> UnicodeObj shimmering that causes data
+ * corruption. [Bug #461322]
+ */
+
+ if (objv[1] == objv[0]) {
+ objPtr = Tcl_DuplicateObj(objv[1]);
+ } else {
+ objPtr = objv[1];
+ }
+ wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen);
+ if (objv[2] == objv[0]) {
+ subPtr = Tcl_DuplicateObj(objv[2]);
+ } else {
+ subPtr = objv[2];
+ }
+ wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen);
+
result = TCL_OK;
resultPtr = Tcl_NewUnicodeObj(wstring, 0);
Tcl_IncrRefCount(resultPtr);
@@ -598,7 +607,8 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
break;
}
if ((numMatches == 0) && (offset > 0)) {
- /* Copy the initial portion of the string in if an offset
+ /*
+ * Copy the initial portion of the string in if an offset
* was specified.
*/
Tcl_AppendUnicodeToObj(resultPtr, wstring, offset);
@@ -695,9 +705,9 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
} else if (offset < wlen) {
Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
}
- if (Tcl_ObjSetVar2(interp, varPtr, NULL, resultPtr, 0) == NULL) {
+ if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr, 0) == NULL) {
Tcl_AppendResult(interp, "couldn't set variable \"",
- Tcl_GetString(varPtr), "\"", (char *) NULL);
+ Tcl_GetString(objv[3]), "\"", (char *) NULL);
result = TCL_ERROR;
} else {
/*
@@ -709,6 +719,8 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
}
done:
+ if (objv[1] == objv[0]) { Tcl_DecrRefCount(objPtr); }
+ if (objv[2] == objv[0]) { Tcl_DecrRefCount(subPtr); }
Tcl_DecrRefCount(resultPtr);
return result;
}