From 315198312f0b545b058b63918b6d0497d3f44b0c Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 12 Mar 2007 19:10:49 +0000
Subject:         * generic/tclNamesp.c (NsEnsembleImplementationCmd):    Make
 efficient         * tests/namespace.test (namespace-42.8):        private
 copy of the         command prefix as we invoke the command appropriate to a
 particular         subcommand of a particular ensemble to avoid panic due to
 shimmering         of the List intrep.  [Bug 1670091]

---
 ChangeLog            |  6 ++++++
 generic/tclNamesp.c  |  6 ++++--
 tests/namespace.test | 16 +++++++++++++++-
 3 files changed, 25 insertions(+), 3 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index bb2855b..bbbb621 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
 2007-03-12  Don Porter  <dgp@users.sourceforge.net>
 
+	* generic/tclNamesp.c (NsEnsembleImplementationCmd):	Make efficient
+	* tests/namespace.test (namespace-42.8):	private copy of the
+	command prefix as we invoke the command appropriate to a particular
+	subcommand of a particular ensemble to avoid panic due to shimmering
+	of the List intrep.  [Bug 1670091]
+
 	* generic/tclVar.c (TclArraySet):	Make efficient private copy of
 	* tests/var.test (var-17.1):	the "list" argument to [array set] to
 	avoid crash due to shimmering invalidating pointers.  [Bug 1669489].
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 2aa4aef..34a449d 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -22,7 +22,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.125 2007/02/08 18:43:40 dgp Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.126 2007/03/12 19:10:49 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -6308,8 +6308,9 @@ NsEnsembleImplementationCmd(
     {
 	Interp *iPtr = (Interp *) interp;
 	int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
+	Tcl_Obj *copyObj = TclListObjCopy(NULL, prefixObj);
 
-	Tcl_ListObjGetElements(NULL, prefixObj, &prefixObjc, &prefixObjv);
+	Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
 	if (isRootEnsemble) {
 	    iPtr->ensembleRewrite.sourceObjs = objv;
 	    iPtr->ensembleRewrite.numRemovedObjs = 2;
@@ -6329,6 +6330,7 @@ NsEnsembleImplementationCmd(
 	memcpy(tempObjv+prefixObjc, objv+2, sizeof(Tcl_Obj *) * (objc-2));
 	result = Tcl_EvalObjv(interp, objc-2+prefixObjc, tempObjv,
 		TCL_EVAL_INVOKE);
+	Tcl_DecrRefCount(copyObj);
 	Tcl_DecrRefCount(prefixObj);
 	TclStackFree(interp);
 	if (isRootEnsemble) {
diff --git a/tests/namespace.test b/tests/namespace.test
index a8e9fd5..f8433cc 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: namespace.test,v 1.65 2007/02/08 18:43:41 dgp Exp $
+# RCS: @(#) $Id: namespace.test,v 1.66 2007/03/12 19:10:50 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -1547,6 +1547,20 @@ test namespace-42.7 {ensembles: nested} {
     namespace delete ns
     set result
 } {{1 ::ns::x0::z} 1 2 3}
+test namespace-42.8 {ensembles: [Bug 1670091]} -setup {
+    proc demo args {}
+    variable target [list [namespace which demo] x]
+    proc trial args {variable target; string length $target}
+    trace add execution demo enter [namespace code trial]
+    namespace ensemble create -command foo -map [list bar $target]
+} -body {
+    foo bar
+} -cleanup {
+    unset target
+    rename demo {}
+    rename trial {}
+    rename foo {}
+} -result {}
 
 test namespace-43.1 {ensembles: dict-driven} {
     namespace eval ns {
-- 
cgit v0.12