Fix crash in [string map] when objects are shared. [Bug 1018562]

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  <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