Fix a crash caused by sharing in [string map]. [Bug 1018562]

3 files changed, 32 insertions, 6 deletions

diff --git a/ChangeLog b/ChangeLog
index 2328c8c..ff5f96b 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  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