diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 27 | ||||
| -rw-r--r-- | tests/string.test | 6 |
3 files changed, 32 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 Donal K. Fellows <donal.k.fellows@man.ac.uk> * generic/tclNamesp.c (FindEnsemble): Factor out the code to diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index f41bfaf..235a9f9 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.104 2004/07/07 14:00:05 dgp Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.105 2004/08/30 18:06:33 dkf Exp $ */ #include "tclInt.h" @@ -1983,8 +1983,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) break; } case STR_MAP: { - int mapElemc, nocase = 0, mapWithDict = 0; - Tcl_Obj **mapElemv; + int mapElemc, nocase = 0, mapWithDict = 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)); @@ -2006,6 +2006,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) } } + /* * This test is tricky, but has to be that way or you get * other strange inconsistencies (see test string-10.20 @@ -2060,9 +2061,19 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) 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 @@ -2070,6 +2081,9 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) if (mapWithDict) { ckfree((char *) mapElemv); } + if (copySource) { + Tcl_DecrRefCount(sourceObj); + } break; } end = ustring1 + length1; @@ -2192,6 +2206,9 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) if (mapWithDict) { ckfree((char *) mapElemv); } + if (copySource) { + Tcl_DecrRefCount(sourceObj); + } break; } case STR_MATCH: { diff --git a/tests/string.test b/tests/string.test index 4021feb..b80d223 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.41 2004/06/30 12:34:36 dkf Exp $ +# RCS: @(#) $Id: string.test,v 1.42 2004/08/30 18:06:34 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -808,6 +808,10 @@ test string-10.20 {string map, dictionaries can alter map ordering} { set map {aa X a Y} list [string map [dict create aa X a Y] aaa] [string map $map aaa] [dict size $map] [string map $map aaa] } {YYY XY 2 XY} +test string-10.21 {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 |