diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 26 | ||||
| -rw-r--r-- | tests/string.test | 6 |
3 files changed, 31 insertions, 6 deletions
@@ -1,3 +1,8 @@ +2004-08-30 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * generic/tclCmdMZ.c (Tcl_StringObjCmd): Stop [string map] from + crashing when its map and input string are the same object. + 2004-08-27 Daniel Steffen <das@users.sourceforge.net> * tests/env.test: macosx fixes. diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 09c3853..1bf2183 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -14,7 +14,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.82.2.11 2004/03/01 17:33:21 dgp Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.82.2.12 2004/08/30 18:15:24 dkf Exp $ */ #include "tclInt.h" @@ -1857,8 +1857,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) break; } case STR_MAP: { - int mapElemc, nocase = 0; - Tcl_Obj **mapElemv; + int mapElemc, nocase = 0, copySource = 0; + Tcl_Obj **mapElemv, *sourceObj; Tcl_UniChar *ustring1, *ustring2, *p, *end; int (*strCmpFn)_ANSI_ARGS_((CONST Tcl_UniChar*, CONST Tcl_UniChar*, unsigned long)); @@ -1898,13 +1898,26 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) Tcl_SetStringObj(resultPtr, "char map list unbalanced", -1); return TCL_ERROR; } - objc--; - ustring1 = Tcl_GetUnicodeFromObj(objv[objc], &length1); + /* + * Take a copy of the source string object if it is the + * same as the map string to cut out nasty sharing + * crashes. [Bug 1018562] + */ + if (objv[objc-2] == objv[objc-1]) { + sourceObj = Tcl_DuplicateObj(objv[objc-1]); + copySource = 1; + } else { + sourceObj = objv[objc-1]; + } + ustring1 = Tcl_GetUnicodeFromObj(sourceObj, &length1); if (length1 == 0) { /* * Empty input string, just stop now */ + if (copySource) { + Tcl_DecrRefCount(sourceObj); + } break; } end = ustring1 + length1; @@ -2024,6 +2037,9 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) */ Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p); } + if (copySource) { + Tcl_DecrRefCount(sourceObj); + } break; } case STR_MATCH: { diff --git a/tests/string.test b/tests/string.test index 6e937f4..a48df1c 100644 --- a/tests/string.test +++ b/tests/string.test @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: string.test,v 1.36.2.2 2003/06/09 21:51:56 dgp Exp $ +# RCS: @(#) $Id: string.test,v 1.36.2.3 2004/08/30 18:15:25 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -760,6 +760,10 @@ test string-10.18 {string map, empty argument} { test string-10.19 {string map, empty arguments} { string map -nocase {{} abc f bar {} def} foo } baroo +test string-10.20 {string map, nasty sharing crash from [Bug 1018562]} { + set a {a b} + string map $a $a +} {b b} test string-11.1 {string match, too few args} { list [catch {string match a} msg] $msg |