From 81b15600f5cee6d721bd157eef9347bfab1521fe Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 4 Jul 2003 10:30:27 +0000
Subject: [string map] now can take dictionaries for maps but the condition for
 doing so is deeply tricky. [Bug 759936]

---
 ChangeLog          |  4 +++
 generic/tclCmdMZ.c | 78 +++++++++++++++++++++++++++++++++++++++++-------------
 tests/string.test  |  6 ++++-
 3 files changed, 69 insertions(+), 19 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index eceba99..ae498ed 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
 2003-07-04  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
 
+	* generic/tclCmdMZ.c (Tcl_StringObjCmd): Made [string map] accept
+	dictionaries for maps.  This is much trickier than it looks, since
+	map entry ordering is significant.  [Bug 759936]
+
 	* generic/tclVar.c (Tcl_ArrayObjCmd, TclArraySet): Made [array
 	get] and [array set] work with dictionaries, producing them and
 	consuming them.  Note that for compatability reasons, you will
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 9c212ab..33fc59f 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.92 2003/06/25 23:02:11 dkf Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.93 2003/07/04 10:30:27 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -1811,11 +1811,11 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 	    break;
 	}
 	case STR_MAP: {
-	    int mapElemc, nocase = 0;
+	    int mapElemc, nocase = 0, mapWithDict = 0;
 	    Tcl_Obj **mapElemv;
 	    Tcl_UniChar *ustring1, *ustring2, *p, *end;
 	    int (*strCmpFn)_ANSI_ARGS_((CONST Tcl_UniChar*,
-					CONST Tcl_UniChar*, unsigned long));
+		    CONST Tcl_UniChar*, unsigned long));
 
 	    if (objc < 4 || objc > 5) {
 	        Tcl_WrongNumArgs(interp, 2, objv, "?-nocase? charMap string");
@@ -1829,28 +1829,64 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 		    nocase = 1;
 		} else {
 		    Tcl_AppendStringsToObj(resultPtr, "bad option \"",
-					   string2, "\": must be -nocase",
-					   (char *) NULL);
+			    string2, "\": must be -nocase", (char *) NULL);
 		    return TCL_ERROR;
 		}
 	    }
 
-	    if (Tcl_ListObjGetElements(interp, objv[objc-2], &mapElemc,
-				       &mapElemv) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    if (mapElemc == 0) {
+	    /*
+	     * This test is tricky, but has to be that way or you get
+	     * other strange inconsistencies (see test string-10.20
+	     * for illustration why!)
+	     */
+	    if (objv[objc-2]->typePtr == &tclDictType &&
+		    objv[objc-2]->bytes == NULL) {
+		int i, done;
+		Tcl_DictSearch search;
+
 		/*
-		 * empty charMap, just return whatever string was given
+		 * We know the type exactly, so all dict operations
+		 * will succeed for sure.  This shortens this code
+		 * quite a bit.
 		 */
-		Tcl_SetObjResult(interp, objv[objc-1]);
-		return TCL_OK;
-	    } else if (mapElemc & 1) {
+		Tcl_DictObjSize(interp, objv[objc-2], &mapElemc);
+		if (mapElemc == 0) {
+		    /*
+		     * empty charMap, just return whatever string was given
+		     */
+		    Tcl_SetObjResult(interp, objv[objc-1]);
+		    return TCL_OK;
+		}
+		mapElemc *= 2;
+		mapWithDict = 1;
 		/*
-		 * The charMap must be an even number of key/value items
+		 * Copy the dictionary out into an array; that's the
+		 * easiest way to adapt this code...
 		 */
-		Tcl_SetStringObj(resultPtr, "char map list unbalanced", -1);
-		return TCL_ERROR;
+		mapElemv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * mapElemc);
+		Tcl_DictObjFirst(interp, objv[objc-2], &search,
+			mapElemv+0, mapElemv+1, &done);
+		for (i=2 ; i<mapElemc ; i+=2) {
+		    Tcl_DictObjNext(&search, mapElemv+i, mapElemv+i+1, &done);
+		}
+	    } else {
+		if (Tcl_ListObjGetElements(interp, objv[objc-2],
+			&mapElemc, &mapElemv) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+		if (mapElemc == 0) {
+		    /*
+		     * empty charMap, just return whatever string was given
+		     */
+		    Tcl_SetObjResult(interp, objv[objc-1]);
+		    return TCL_OK;
+		} else if (mapElemc & 1) {
+		    /*
+		     * The charMap must be an even number of key/value items
+		     */
+		    Tcl_SetStringObj(resultPtr, "char map list unbalanced", -1);
+		    return TCL_ERROR;
+		}
 	    }
 	    objc--;
 
@@ -1859,6 +1895,9 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 		/*
 		 * Empty input string, just stop now
 		 */
+		if (mapWithDict) {
+		    ckfree((char *) mapElemv);
+		}
 		break;
 	    }
 	    end = ustring1 + length1;
@@ -1921,7 +1960,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 		mapLens = (int *) ckalloc((mapElemc * 2) * sizeof(int));
 		if (nocase) {
 		    u2lc = (Tcl_UniChar *)
-			ckalloc((mapElemc) * sizeof(Tcl_UniChar));
+			    ckalloc((mapElemc) * sizeof(Tcl_UniChar));
 		}
 		for (index = 0; index < mapElemc; index++) {
 		    mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
@@ -1978,6 +2017,9 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
 		 */
 		Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p);
 	    }
+	    if (mapWithDict) {
+		ckfree((char *) mapElemv);
+	    }
 	    break;
 	}
 	case STR_MATCH: {
diff --git a/tests/string.test b/tests/string.test
index 40e84ed..083e145 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.38 2003/06/09 21:51:37 dgp Exp $
+# RCS: @(#) $Id: string.test,v 1.39 2003/07/04 10:30:27 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, 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-11.1 {string match, too few args} {
     list [catch {string match a} msg] $msg
-- 
cgit v0.12