From 54f15bb144abf1e98db0a7bf90f741a93b41eff4 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 30 Aug 2004 18:15:24 +0000 Subject: Fix crash in [string map] when objects are shared. [Bug 1018562] --- ChangeLog | 5 +++++ generic/tclCmdMZ.c | 26 +++++++++++++++++++++----- tests/string.test | 6 +++++- 3 files changed, 31 insertions(+), 6 deletions(-) diff --git a/ChangeLog b/ChangeLog index 0b2a0ba..9391122 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2004-08-30 Donal K. Fellows + + * 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 * 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 -- cgit v0.12