[4f6a1ebd64] Stop crash when same value passed to the -map and -subcommands options of ensemble configuration.

1 files changed, 173 insertions, 154 deletions

diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index c1b0890..b79eaa3 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -2399,13 +2399,31 @@ MakeCachedEnsembleCommand(
  */
 
 static void
+ClearTable(
+    EnsembleConfig *ensemblePtr)
+{
+    Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
+
+    if (hash->numEntries != 0) {
+        Tcl_HashSearch search;
+        Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search);
+
+        while (hPtr != NULL) {
+            Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr);
+            Tcl_DecrRefCount(prefixObj);
+            hPtr = Tcl_NextHashEntry(&search);
+        }
+        ckfree((char *) ensemblePtr->subcommandArrayPtr);
+    }
+    Tcl_DeleteHashTable(hash);
+}
+
+static void
 DeleteEnsembleConfig(
     ClientData clientData)
 {
     EnsembleConfig *ensemblePtr = clientData;
     Namespace *nsPtr = ensemblePtr->nsPtr;
-    Tcl_HashSearch search;
-    Tcl_HashEntry *hEnt;
 
     /*
      * Unlink from the ensemble chain if it has not been marked as having been
@@ -2439,17 +2457,7 @@ DeleteEnsembleConfig(
      * Kill the pointer-containing fields.
      */
 
-    if (ensemblePtr->subcommandTable.numEntries != 0) {
-	ckfree(ensemblePtr->subcommandArrayPtr);
-    }
-    hEnt = Tcl_FirstHashEntry(&ensemblePtr->subcommandTable, &search);
-    while (hEnt != NULL) {
-	Tcl_Obj *prefixObj = Tcl_GetHashValue(hEnt);
-
-	Tcl_DecrRefCount(prefixObj);
-	hEnt = Tcl_NextHashEntry(&search);
-    }
-    Tcl_DeleteHashTable(&ensemblePtr->subcommandTable);
+    ClearTable(ensemblePtr);
     if (ensemblePtr->subcmdList != NULL) {
 	Tcl_DecrRefCount(ensemblePtr->subcmdList);
     }
@@ -2505,148 +2513,159 @@ BuildEnsembleConfig(
     int i, j, isNew;
     Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
     Tcl_HashEntry *hPtr;
-
-    if (hash->numEntries != 0) {
-	/*
-	 * Remove pre-existing table.
-	 */
-
-	ckfree(ensemblePtr->subcommandArrayPtr);
-	hPtr = Tcl_FirstHashEntry(hash, &search);
-	while (hPtr != NULL) {
-	    Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr);
-
-	    Tcl_DecrRefCount(prefixObj);
-	    hPtr = Tcl_NextHashEntry(&search);
-	}
-	Tcl_DeleteHashTable(hash);
-	Tcl_InitHashTable(hash, TCL_STRING_KEYS);
-    }
-
-    /*
-     * See if we've got an export list. If so, we will only export exactly
-     * those commands, which may be either implemented by the prefix in the
-     * subcommandDict or mapped directly onto the namespace's commands.
-     */
-
-    if (ensemblePtr->subcmdList != NULL) {
-	Tcl_Obj **subcmdv, *target, *cmdObj, *cmdPrefixObj;
-	int subcmdc;
-
-	TclListObjGetElements(NULL, ensemblePtr->subcmdList, &subcmdc,
-		&subcmdv);
-	for (i=0 ; i<subcmdc ; i++) {
-	    const char *name = TclGetString(subcmdv[i]);
-
-	    hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
-
-	    /*
-	     * Skip non-unique cases.
-	     */
-
-	    if (!isNew) {
-		continue;
-	    }
-
-	    /*
-	     * Look in our dictionary (if present) for the command.
-	     */
-
-	    if (ensemblePtr->subcommandDict != NULL) {
-		Tcl_DictObjGet(NULL, ensemblePtr->subcommandDict, subcmdv[i],
-			&target);
-		if (target != NULL) {
-		    Tcl_SetHashValue(hPtr, target);
-		    Tcl_IncrRefCount(target);
-		    continue;
-		}
-	    }
-
-	    /*
-	     * Not there, so map onto the namespace. Note in this case that we
-	     * do not guarantee that the command is actually there; that is
-	     * the programmer's responsibility (or [::unknown] of course).
-	     */
-
-	    cmdObj = NewNsObj((Tcl_Namespace *) ensemblePtr->nsPtr);
-	    if (ensemblePtr->nsPtr->parentPtr != NULL) {
-		Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
-	    } else {
-		Tcl_AppendStringsToObj(cmdObj, name, NULL);
-	    }
-	    cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
-	    Tcl_SetHashValue(hPtr, cmdPrefixObj);
-	    Tcl_IncrRefCount(cmdPrefixObj);
-	}
-    } else if (ensemblePtr->subcommandDict != NULL) {
-	/*
-	 * No subcmd list, but we do have a mapping dictionary so we should
-	 * use the keys of that. Convert the dictionary's contents into the
-	 * form required for the ensemble's internal hashtable.
-	 */
-
-	Tcl_DictSearch dictSearch;
-	Tcl_Obj *keyObj, *valueObj;
-	int done;
-
-	Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch,
-		&keyObj, &valueObj, &done);
-	while (!done) {
-	    const char *name = TclGetString(keyObj);
-
-	    hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
-	    Tcl_SetHashValue(hPtr, valueObj);
-	    Tcl_IncrRefCount(valueObj);
-	    Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
-	}
+    Tcl_Obj *mapDict = ensemblePtr->subcommandDict;
+    Tcl_Obj *subList = ensemblePtr->subcmdList;
+
+    ClearTable(ensemblePtr);
+    Tcl_InitHashTable(hash, TCL_STRING_KEYS);
+
+    if (subList) {
+        int subc;
+        Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj;
+        char *name;
+
+        /*
+         * There is a list of exactly what subcommands go in the table.
+         * Must determine the target for each.
+         */
+
+        Tcl_ListObjGetElements(NULL, subList, &subc, &subv);
+        if (subList == mapDict) {
+            /*
+             * Strange case where explicit list of subcommands is same value
+             * as the dict mapping to targets.
+             */
+
+            for (i = 0; i < subc; i += 2) {
+                name = TclGetString(subv[i]);
+                hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
+                if (!isNew) {
+                    cmdObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
+                    Tcl_DecrRefCount(cmdObj);
+                }
+                Tcl_SetHashValue(hPtr, subv[i+1]);
+                Tcl_IncrRefCount(subv[i+1]);
+
+                name = TclGetString(subv[i+1]);
+                hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
+                if (isNew) {
+                    cmdObj = Tcl_NewStringObj(ensemblePtr->nsPtr->fullName, -1);
+                    if (ensemblePtr->nsPtr->parentPtr != NULL) {
+                        Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
+                    } else {
+                        Tcl_AppendStringsToObj(cmdObj, name, NULL);
+                    }
+                    cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
+                    Tcl_SetHashValue(hPtr, cmdPrefixObj);
+                    Tcl_IncrRefCount(cmdPrefixObj);
+                }
+            }
+        } else {
+            /* Usual case where we can freely act on the list and dict. */
+
+            for (i = 0; i < subc; i++) {
+                name = TclGetString(subv[i]);
+                hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
+                if (!isNew) {
+                    continue;
+                }
+
+                /* Lookup target in the dictionary */
+                if (mapDict) {
+                    Tcl_DictObjGet(NULL, mapDict, subv[i], &target);
+                    if (target) {
+                        Tcl_SetHashValue(hPtr, target);
+                        Tcl_IncrRefCount(target);
+                        continue;
+                    }
+                }
+
+                /*
+                 * target was not in the dictionary so map onto the namespace.
+                 * Note in this case that we do not guarantee that the
+                 * command is actually there; that is the programmer's
+                 * responsibility (or [::unknown] of course).
+                 */
+                cmdObj = Tcl_NewStringObj(ensemblePtr->nsPtr->fullName, -1);
+                if (ensemblePtr->nsPtr->parentPtr != NULL) {
+                    Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
+                } else {
+                    Tcl_AppendStringsToObj(cmdObj, name, NULL);
+                }
+                cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
+                Tcl_SetHashValue(hPtr, cmdPrefixObj);
+                Tcl_IncrRefCount(cmdPrefixObj);
+            }
+        }
+    } else if (mapDict) {
+        /*
+         * No subcmd list, but we do have a mapping dictionary so we should
+         * use the keys of that. Convert the dictionary's contents into the
+         * form required for the ensemble's internal hashtable.
+         */
+
+        Tcl_DictSearch dictSearch;
+        Tcl_Obj *keyObj, *valueObj;
+        int done;
+
+        Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch,
+                &keyObj, &valueObj, &done);
+        while (!done) {
+            char *name = TclGetString(keyObj);
+
+            hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
+            Tcl_SetHashValue(hPtr, valueObj);
+            Tcl_IncrRefCount(valueObj);
+            Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
+        }
     } else {
-	/*
-	 * Discover what commands are actually exported by the namespace.
-	 * What we have is an array of patterns and a hash table whose keys
-	 * are the command names exported by the namespace (the contents do
-	 * not matter here.) We must find out what commands are actually
-	 * exported by filtering each command in the namespace against each of
-	 * the patterns in the export list. Note that we use an intermediate
-	 * hash table to make memory management easier, and because that makes
-	 * exact matching far easier too.
-	 *
-	 * Suggestion for future enhancement: compute the unique prefixes and
-	 * place them in the hash too, which should make for even faster
-	 * matching.
-	 */
-
-	hPtr = Tcl_FirstHashEntry(&ensemblePtr->nsPtr->cmdTable, &search);
-	for (; hPtr!= NULL ; hPtr=Tcl_NextHashEntry(&search)) {
-	    char *nsCmdName =		/* Name of command in namespace. */
-		    Tcl_GetHashKey(&ensemblePtr->nsPtr->cmdTable, hPtr);
-
-	    for (i=0 ; i<ensemblePtr->nsPtr->numExportPatterns ; i++) {
-		if (Tcl_StringMatch(nsCmdName,
-			ensemblePtr->nsPtr->exportArrayPtr[i])) {
-		    hPtr = Tcl_CreateHashEntry(hash, nsCmdName, &isNew);
-
-		    /*
-		     * Remember, hash entries have a full reference to the
-		     * substituted part of the command (as a list) as their
-		     * content!
-		     */
-
-		    if (isNew) {
-			Tcl_Obj *cmdObj, *cmdPrefixObj;
-
-			TclNewObj(cmdObj);
-			Tcl_AppendStringsToObj(cmdObj,
-				ensemblePtr->nsPtr->fullName,
-				(ensemblePtr->nsPtr->parentPtr ? "::" : ""),
-				nsCmdName, NULL);
-			cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
-			Tcl_SetHashValue(hPtr, cmdPrefixObj);
-			Tcl_IncrRefCount(cmdPrefixObj);
-		    }
-		    break;
-		}
-	    }
-	}
+        /*
+         * Discover what commands are actually exported by the namespace.
+         * What we have is an array of patterns and a hash table whose keys
+         * are the command names exported by the namespace (the contents do
+         * not matter here.) We must find out what commands are actually
+         * exported by filtering each command in the namespace against each of
+         * the patterns in the export list. Note that we use an intermediate
+         * hash table to make memory management easier, and because that makes
+         * exact matching far easier too.
+         *
+         * Suggestion for future enhancement: compute the unique prefixes and
+         * place them in the hash too, which should make for even faster
+         * matching.
+         */
+
+        hPtr = Tcl_FirstHashEntry(&ensemblePtr->nsPtr->cmdTable, &search);
+        for (; hPtr!= NULL ; hPtr=Tcl_NextHashEntry(&search)) {
+            char *nsCmdName =           /* Name of command in namespace. */
+                    Tcl_GetHashKey(&ensemblePtr->nsPtr->cmdTable, hPtr);
+
+            for (i=0 ; i<ensemblePtr->nsPtr->numExportPatterns ; i++) {
+                if (Tcl_StringMatch(nsCmdName,
+                        ensemblePtr->nsPtr->exportArrayPtr[i])) {
+                    hPtr = Tcl_CreateHashEntry(hash, nsCmdName, &isNew);
+
+                    /*
+                     * Remember, hash entries have a full reference to the
+                     * substituted part of the command (as a list) as their
+                     * content!
+                     */
+
+                    if (isNew) {
+                        Tcl_Obj *cmdObj, *cmdPrefixObj;
+
+                        TclNewObj(cmdObj);
+                        Tcl_AppendStringsToObj(cmdObj,
+                                ensemblePtr->nsPtr->fullName,
+                                (ensemblePtr->nsPtr->parentPtr ? "::" : ""),
+                                nsCmdName, NULL);
+                        cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
+                        Tcl_SetHashValue(hPtr, cmdPrefixObj);
+                        Tcl_IncrRefCount(cmdPrefixObj);
+                    }
+                    break;
+                }
+            }
+        }
     }
 
     if (hash->numEntries == 0) {