diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 6 | ||||
| -rw-r--r-- | tests/namespace.test | 16 |
3 files changed, 25 insertions, 3 deletions
@@ -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 { |