Fix for issue [4f6a1ebd64]: ensemble: segmentation fault when -subcommand and

-map values are the same object.

2 files changed, 30 insertions, 2 deletions

diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index f3e8187..392f430 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -2505,6 +2505,7 @@ BuildEnsembleConfig(
     int i, j, isNew;
     Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
     Tcl_HashEntry *hPtr;
+    Tcl_Obj *subcmdDictCopy = NULL ;
 
     if (hash->numEntries != 0) {
 	/*
@@ -2553,7 +2554,15 @@ BuildEnsembleConfig(
 	     */
 
 	    if (ensemblePtr->subcommandDict != NULL) {
-		Tcl_DictObjGet(NULL, ensemblePtr->subcommandDict, subcmdv[i],
+		if (subcmdDictCopy == NULL) {
+		    if (ensemblePtr->subcmdList == ensemblePtr->subcommandDict) {
+			subcmdDictCopy = Tcl_DuplicateObj(ensemblePtr->subcommandDict);
+		    } else {
+			subcmdDictCopy = ensemblePtr->subcommandDict; 
+		    }
+		    Tcl_IncrRefCount(subcmdDictCopy);
+		}
+		Tcl_DictObjGet(NULL, subcmdDictCopy, subcmdv[i],
 			&target);
 		if (target != NULL) {
 		    Tcl_SetHashValue(hPtr, target);
@@ -2578,6 +2587,9 @@ BuildEnsembleConfig(
 	    Tcl_SetHashValue(hPtr, cmdPrefixObj);
 	    Tcl_IncrRefCount(cmdPrefixObj);
 	}
+	if (subcmdDictCopy != NULL) {
+	    Tcl_DecrRefCount(subcmdDictCopy);
+	}
     } else if (ensemblePtr->subcommandDict != NULL) {
 	/*
 	 * No subcmd list, but we do have a mapping dictionary so we should
diff --git a/tests/namespace.test b/tests/namespace.test
index f6f817b..623f06d 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -1785,7 +1785,10 @@ test namespace-42.7 {ensembles: nested} -body {
 } -cleanup {
     namespace delete ns
 } -result {{1 ::ns::x0::z} 1 2 3}
-test namespace-42.8 {ensembles: [Bug 1670091]} -setup {
+test namespace-42.8 {
+    ensembles: [Bug 1670091], panic due to pointer to a deallocated List
+    struct.
+} -setup {
     proc demo args {}
     variable target [list [namespace which demo] x]
     proc trial args {variable target; string length $target}
@@ -1800,6 +1803,19 @@ test namespace-42.8 {ensembles: [Bug 1670091]} -setup {
     rename foo {}
 } -result {}
 
+test namespace-42.9 {
+    ensembles: [Bug 4f6a1ebd64], segmentation fault due to pointer to a
+    deallocated List struct.
+} -setup {
+    namespace eval n {namespace ensemble create}
+    dict set list one ::two
+    namespace ensemble configure n -subcommands $list -map $list
+} -body {
+    n one
+} -cleanup {
+    namespace delete n
+} -returnCodes error -match glob -result {invalid command name*}
+
 test namespace-43.1 {ensembles: dict-driven} {
     namespace eval ns {
 	namespace export x*