diff options
author | hobbs <hobbs> | 2001-09-13 23:49:56 (GMT) |
---|---|---|
committer | hobbs <hobbs> | 2001-09-13 23:49:56 (GMT) |
commit | 37be4afdd112e8b929bc2005e753d1df3b500065 (patch) | |
tree | 52febc2fcdf5ae70a517592874d30583efea37e5 /generic | |
parent | 298ec8a4e8fbb3d26a8c5a4e3c8b46fc4121fcc5 (diff) | |
download | tcl-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.c | 42 |
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; } |