Attachment "ensemble-parameters-v2.patch" to
ticket [1901783fff]
added by
lars_h
2008-08-20 19:23:07.
Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.142
diff -u -r1.142 tcl.decls
--- generic/tcl.decls 29 Jul 2008 05:30:25 -0000 1.142
+++ generic/tcl.decls 20 Aug 2008 12:07:49 -0000
@@ -2146,6 +2146,17 @@
Tcl_Obj *CONST objv[])
}
+# TIP#314 (ensembles with parameters)
+declare 589 generic {
+ int Tcl_SetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token,
+ Tcl_Obj *paramList)
+}
+declare 590 generic {
+ int Tcl_GetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token,
+ Tcl_Obj **paramListPtr)
+}
+
+
##############################################################################
# Define the platform specific public Tcl interface. These functions are
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.174
diff -u -r1.174 tclNamesp.c
--- generic/tclNamesp.c 3 Aug 2008 17:33:12 -0000 1.174
+++ generic/tclNamesp.c 20 Aug 2008 12:07:53 -0000
@@ -111,9 +111,11 @@
* field. */
int flags; /* ORed combo of TCL_ENSEMBLE_PREFIX, ENS_DEAD
* and ENSEMBLE_COMPILE. */
+ int numParameters; /* Cached number of parameters. */
/* OBJECT FIELDS FOR ENSEMBLE CONFIGURATION */
+ Tcl_Obj *parameterList; /* List of ensemble parameter names. */
Tcl_Obj *subcommandDict; /* Dictionary providing mapping from
* subcommands to their implementing command
* prefixes, or NULL if we are to build the
@@ -144,6 +146,9 @@
#define ENS_DEAD 0x1 /* Flag value to say that the ensemble is dead
* and on its way out. */
+
+
+
/*
* Declarations for functions local to this file:
*/
@@ -4797,16 +4802,20 @@
ENS_CONFIG, ENS_CREATE, ENS_EXISTS
};
static const char *createOptions[] = {
- "-command", "-map", "-prefixes", "-subcommands", "-unknown", NULL
+ "-command", "-map", "-parameters", "-prefixes", "-subcommands",
+ "-unknown", NULL
};
enum EnsCreateOpts {
- CRT_CMD, CRT_MAP, CRT_PREFIX, CRT_SUBCMDS, CRT_UNKNOWN
+ CRT_CMD, CRT_MAP, CRT_PARAM, CRT_PREFIX, CRT_SUBCMDS,
+ CRT_UNKNOWN
};
static const char *configOptions[] = {
- "-map", "-namespace", "-prefixes", "-subcommands", "-unknown", NULL
+ "-map", "-namespace", "-parameters", "-prefixes", "-subcommands",
+ "-unknown", NULL
};
enum EnsConfigOpts {
- CONF_MAP, CONF_NAMESPACE, CONF_PREFIX, CONF_SUBCMDS, CONF_UNKNOWN
+ CONF_MAP, CONF_NAMESPACE, CONF_PARAM, CONF_PREFIX, CONF_SUBCMDS,
+ CONF_UNKNOWN
};
int index;
@@ -4841,6 +4850,7 @@
Tcl_Obj *mapObj = NULL;
int permitPrefix = 1;
Tcl_Obj *unknownObj = NULL;
+ Tcl_Obj *paramObj = NULL;
objv += 3;
objc -= 3;
@@ -4881,6 +4891,15 @@
}
subcmdObj = (len > 0 ? objv[1] : NULL);
continue;
+ case CRT_PARAM:
+ if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
+ if (allocatedMapFlag) {
+ Tcl_DecrRefCount(mapObj);
+ }
+ return TCL_ERROR;
+ }
+ paramObj = (len > 0 ? objv[1] : NULL);
+ continue;
case CRT_MAP: {
Tcl_Obj *patchedDict = NULL, *subcmdObj;
@@ -4987,6 +5006,7 @@
Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
Tcl_SetEnsembleMappingDict(interp, token, mapObj);
Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
+ Tcl_SetEnsembleParameterList(interp, token, paramObj);
/*
* Tricky! Must ensure that the result is not shared (command delete
@@ -5032,6 +5052,12 @@
Tcl_SetObjResult(interp, resultObj);
}
break;
+ case CONF_PARAM:
+ Tcl_GetEnsembleParameterList(NULL, token, &resultObj);
+ if (resultObj != NULL) {
+ Tcl_SetObjResult(interp, resultObj);
+ }
+ break;
case CONF_MAP:
Tcl_GetEnsembleMappingDict(NULL, token, &resultObj);
if (resultObj != NULL) {
@@ -5089,6 +5115,13 @@
Tcl_NewStringObj(((Namespace *)namespacePtr)->fullName,
-1));
+ /* -parameters option */
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ Tcl_NewStringObj(configOptions[CONF_PARAM], -1));
+ Tcl_GetEnsembleParameterList(NULL, token, &tmpObj);
+ Tcl_ListObjAppendElement(NULL, resultObj,
+ (tmpObj != NULL) ? tmpObj : Tcl_NewObj());
+
/* -prefix option */
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewStringObj(configOptions[CONF_PREFIX], -1));
@@ -5116,12 +5149,13 @@
Tcl_DictSearch search;
Tcl_Obj *listObj;
int done, len, allocatedMapFlag = 0;
- Tcl_Obj *subcmdObj = NULL, *mapObj = NULL,
+ Tcl_Obj *subcmdObj = NULL, *mapObj = NULL, *paramObj = NULL,
*unknownObj = NULL; /* Defaults, silence gcc 4 warnings */
int permitPrefix, flags = 0; /* silence gcc 4 warning */
Tcl_GetEnsembleSubcommandList(NULL, token, &subcmdObj);
Tcl_GetEnsembleMappingDict(NULL, token, &mapObj);
+ Tcl_GetEnsembleParameterList(NULL, token, ¶mObj);
Tcl_GetEnsembleUnknownHandler(NULL, token, &unknownObj);
Tcl_GetEnsembleFlags(NULL, token, &flags);
permitPrefix = (flags & TCL_ENSEMBLE_PREFIX) != 0;
@@ -5154,6 +5188,15 @@
}
subcmdObj = (len > 0 ? objv[1] : NULL);
continue;
+ case CONF_PARAM:
+ if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
+ if (allocatedMapFlag) {
+ Tcl_DecrRefCount(mapObj);
+ }
+ return TCL_ERROR;
+ }
+ paramObj = (len > 0 ? objv[1] : NULL);
+ continue;
case CONF_MAP: {
Tcl_Obj *patchedDict = NULL, *subcmdObj;
@@ -5263,6 +5306,7 @@
: flags&~TCL_ENSEMBLE_PREFIX);
Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
Tcl_SetEnsembleMappingDict(interp, token, mapObj);
+ Tcl_SetEnsembleParameterList(interp, token, paramObj);
Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
Tcl_SetEnsembleFlags(interp, token, flags);
return TCL_OK;
@@ -5329,6 +5373,8 @@
ensemblePtr->subcmdList = NULL;
ensemblePtr->subcommandDict = NULL;
ensemblePtr->flags = flags;
+ ensemblePtr->numParameters = 0;
+ ensemblePtr->parameterList = NULL;
ensemblePtr->unknownHandler = NULL;
ensemblePtr->token = Tcl_NRCreateCommand(interp, name,
NsEnsembleImplementationCmd, NsEnsembleImplementationCmdNR,
@@ -5431,6 +5477,82 @@
/*
*----------------------------------------------------------------------
*
+ * Tcl_SetEnsembleParameterList --
+ *
+ * Set the parameter list for a particular ensemble.
+ *
+ * Results:
+ * Tcl result code (error if command token does not indicate an ensemble
+ * or the parameter list - if non-NULL - is not a list).
+ *
+ * Side effects:
+ * The ensemble is updated and marked for recompilation.
+ * ((Q: Is the latter necessary?))
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_SetEnsembleParameterList(
+ Tcl_Interp *interp,
+ Tcl_Command token,
+ Tcl_Obj *paramList)
+{
+ Command *cmdPtr = (Command *) token;
+ EnsembleConfig *ensemblePtr;
+ Tcl_Obj *oldList;
+ int length;
+
+ if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ return TCL_ERROR;
+ }
+ if (paramList == NULL) {
+ length = 0;
+ } else {
+ if (TclListObjLength(interp, paramList, &length) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (length < 1) {
+ paramList = NULL;
+ }
+ }
+
+ ensemblePtr = cmdPtr->objClientData;
+ oldList = ensemblePtr->parameterList;
+ ensemblePtr->parameterList = paramList;
+ if (paramList != NULL) {
+ Tcl_IncrRefCount(paramList);
+ }
+ if (oldList != NULL) {
+ TclDecrRefCount(oldList);
+ }
+ ensemblePtr->numParameters = length;
+
+ /*
+ * Trigger an eventual recomputation of the ensemble command set. Note
+ * that this is slightly tricky, as it means that we are not actually
+ * counting the number of namespace export actions, but it is the simplest
+ * way to go!
+ */
+
+ ensemblePtr->nsPtr->exportLookupEpoch++;
+
+ /*
+ * Special hack to make compiling of [info exists] work when the
+ * dictionary is modified.
+ */
+
+ if (cmdPtr->compileProc != NULL) {
+ ((Interp *)interp)->compileEpoch++;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_SetEnsembleMappingDict --
*
* Set the mapping dictionary for a particular ensemble.
@@ -5703,6 +5825,46 @@
/*
*----------------------------------------------------------------------
*
+ * Tcl_GetEnsembleParameterList --
+ *
+ * Get the list of parameters associated with a particular ensemble.
+ *
+ * Results:
+ * Tcl result code (error if command token does not indicate an
+ * ensemble). The list of parameters is returned by updating the
+ * variable pointed to by the last parameter (NULL if there are
+ * no parameters).
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetEnsembleParameterList(
+ Tcl_Interp *interp,
+ Tcl_Command token,
+ Tcl_Obj **paramListPtr)
+{
+ Command *cmdPtr = (Command *) token;
+ EnsembleConfig *ensemblePtr;
+
+ if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "command is not an ensemble", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ ensemblePtr = cmdPtr->objClientData;
+ *paramListPtr = ensemblePtr->parameterList;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_GetEnsembleMappingDict --
*
* Get the command mapping dictionary associated with a particular
@@ -6072,12 +6234,39 @@
* names. */
int reparseCount = 0; /* Number of reparses. */
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
+ restartEnsembleParse:
+ /*
+ * Must recheck objc, since numParameters might have changed.
+ * Cf. test namespace-53.9.
+ */
+ if (objc < 2 + ensemblePtr->numParameters) {
+ /*
+ * We don't have a subcommand argument.
+ * Make error message.
+ */
+ Tcl_DString buf; /* Message being built */
+ Tcl_Obj **elemPtrs; /* Parameter names */
+ int len; /* Number of parameters to append */
+
+ Tcl_DStringInit(&buf);
+ if (ensemblePtr->parameterList == NULL) {
+ len = 0;
+ } else if (TclListObjGetElements(NULL, ensemblePtr->parameterList,
+ &len, &elemPtrs) != TCL_OK) {
+ /* This can't happen. */
+ Tcl_Panic("List of ensemble parameters is not a list");
+ }
+ for (; len>0; len--,elemPtrs++) {
+ Tcl_DStringAppend(&buf, Tcl_GetString(*elemPtrs), -1);
+ Tcl_DStringAppend(&buf, " ", -1);
+ }
+ Tcl_DStringAppend(&buf, "subcommand ?arg ...?", -1);
+ Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf));
+ Tcl_DStringFree(&buf);
+
return TCL_ERROR;
}
- restartEnsembleParse:
if (ensemblePtr->nsPtr->flags & NS_DYING) {
/*
* Don't know how we got here, but make things give up quickly.
@@ -6103,8 +6292,9 @@
* part where we do the invocation of the subcommand.
*/
- if (objv[1]->typePtr == &tclEnsembleCmdType) {
- EnsembleCmdRep *ensembleCmd = objv[1]->internalRep.otherValuePtr;
+ if (objv[1 + ensemblePtr->numParameters]->typePtr == &tclEnsembleCmdType) {
+ EnsembleCmdRep *ensembleCmd =
+ objv[1 + ensemblePtr->numParameters]->internalRep.otherValuePtr;
if (ensembleCmd->nsPtr == ensemblePtr->nsPtr &&
ensembleCmd->epoch == ensemblePtr->epoch &&
@@ -6125,7 +6315,7 @@
*/
hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable,
- TclGetString(objv[1]));
+ TclGetString(objv[1 + ensemblePtr->numParameters]));
if (hPtr != NULL) {
char *fullName = Tcl_GetHashKey(&ensemblePtr->subcommandTable, hPtr);
@@ -6135,7 +6325,8 @@
* Cache for later in the subcommand object.
*/
- MakeCachedEnsembleCommand(objv[1], ensemblePtr, fullName, prefixObj);
+ MakeCachedEnsembleCommand(objv[1 + ensemblePtr->numParameters],
+ ensemblePtr, fullName, prefixObj);
} else if (!(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX)) {
/*
* Could not map, no prefixing, go to unknown/error handling.
@@ -6156,8 +6347,8 @@
int stringLength, i;
int tableLength = ensemblePtr->subcommandTable.numEntries;
- subcmdName = TclGetString(objv[1]);
- stringLength = objv[1]->length;
+ subcmdName = TclGetString(objv[1 + ensemblePtr->numParameters]);
+ stringLength = objv[1 + ensemblePtr->numParameters]->length;
for (i=0 ; i<tableLength ; i++) {
register int cmp = strncmp(subcmdName,
ensemblePtr->subcommandArrayPtr[i],
@@ -6203,7 +6394,8 @@
* Cache for later in the subcommand object.
*/
- MakeCachedEnsembleCommand(objv[1], ensemblePtr, fullName, prefixObj);
+ MakeCachedEnsembleCommand(objv[1 + ensemblePtr->numParameters],
+ ensemblePtr, fullName, prefixObj);
}
Tcl_IncrRefCount(prefixObj);
@@ -6215,7 +6407,11 @@
* number of arguments to this ensemble command), populating it and then
* feeding it back through the main command-lookup engine. In theory, we
* could look up the command in the namespace ourselves, as we already
- * have the namespace in which it is guaranteed to exist, but we don't do
+ * have the namespace in which it is guaranteed to exist,
+ *
+ * ((Q: That's not true if the -map option is used, is it?))
+ *
+ * but we don't do
* that (the cacheing of the command object used should help with that.)
*/
@@ -6251,7 +6447,11 @@
listRepPtr->elemCount = copyObjc;
copyObjv = &listRepPtr->elements;
memcpy(copyObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
- memcpy(copyObjv+prefixObjc, objv+2, sizeof(Tcl_Obj *) * (objc-2));
+ memcpy(copyObjv+prefixObjc, objv+1,
+ sizeof(Tcl_Obj *) * ensemblePtr->numParameters);
+ memcpy(copyObjv+prefixObjc+ensemblePtr->numParameters,
+ objv+ensemblePtr->numParameters+2,
+ sizeof(Tcl_Obj *) * (objc - ensemblePtr->numParameters - 2));
for (i=0; i < copyObjc; i++) {
Tcl_IncrRefCount(copyObjv[i]);
@@ -6262,19 +6462,22 @@
/*
* Record what arguments the script sent in so that things like
* Tcl_WrongNumArgs can give the correct error message.
+ * Parameters count both as inserted and removed arguments.
*/
if (iPtr->ensembleRewrite.sourceObjs == NULL) {
iPtr->ensembleRewrite.sourceObjs = objv;
- iPtr->ensembleRewrite.numRemovedObjs = 2;
- iPtr->ensembleRewrite.numInsertedObjs = prefixObjc;
+ iPtr->ensembleRewrite.numRemovedObjs = 2 + ensemblePtr->numParameters;
+ iPtr->ensembleRewrite.numInsertedObjs = prefixObjc + ensemblePtr->numParameters;
TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL,
NULL);
} else {
- register int ni = iPtr->ensembleRewrite.numInsertedObjs;
-
- if (ni < 2) {
- iPtr->ensembleRewrite.numRemovedObjs += 2 - ni;
+ register int ni = 2 + ensemblePtr->numParameters
+ - iPtr->ensembleRewrite.numInsertedObjs;
+ /* Position in objv of new front
+ * of insertion relative to old one. */
+ if (ni > 0) {
+ iPtr->ensembleRewrite.numRemovedObjs += ni;
iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1;
} else {
iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2;
@@ -6317,18 +6520,20 @@
Tcl_ResetResult(interp);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
- TclGetString(objv[1]), NULL);
+ TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
if (ensemblePtr->subcommandTable.numEntries == 0) {
- Tcl_AppendResult(interp, "unknown subcommand \"",TclGetString(objv[1]),
+ Tcl_AppendResult(interp, "unknown subcommand \"",
+ TclGetString(objv[1+ensemblePtr->numParameters]),
"\": namespace ", ensemblePtr->nsPtr->fullName,
" does not export any commands", NULL);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
- TclGetString(objv[1]), NULL);
+ TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
return TCL_ERROR;
}
Tcl_AppendResult(interp, "unknown ",
(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? "or ambiguous " : ""),
- "subcommand \"", TclGetString(objv[1]), "\": must be ", NULL);
+ "subcommand \"", TclGetString(objv[1+ensemblePtr->numParameters]),
+ "\": must be ", NULL);
if (ensemblePtr->subcommandTable.numEntries == 1) {
Tcl_AppendResult(interp, ensemblePtr->subcommandArrayPtr[0], NULL);
} else {
@@ -6342,7 +6547,7 @@
ensemblePtr->subcommandArrayPtr[i], NULL);
}
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
- TclGetString(objv[1]), NULL);
+ TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
return TCL_ERROR;
}
@@ -6639,6 +6844,9 @@
if (ensemblePtr->subcmdList != NULL) {
Tcl_DecrRefCount(ensemblePtr->subcmdList);
}
+ if (ensemblePtr->parameterList != NULL) {
+ Tcl_DecrRefCount(ensemblePtr->parameterList);
+ }
if (ensemblePtr->subcommandDict != NULL) {
Tcl_DecrRefCount(ensemblePtr->subcommandDict);
}
Index: tests/namespace.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/namespace.test,v
retrieving revision 1.73
diff -u -r1.73 namespace.test
--- tests/namespace.test 19 Jul 2008 22:50:38 -0000 1.73
+++ tests/namespace.test 20 Aug 2008 12:07:58 -0000
@@ -1700,7 +1700,7 @@
}
namespace delete ns
set result
-} {-map {} -namespace ::ns -prefixes 1 -subcommands {} -unknown {}}
+} {-map {} -namespace ::ns -parameters {} -prefixes 1 -subcommands {} -unknown {}}
test namespace-45.2 {ensemble: introspection} {
namespace eval ns {
namespace export x
@@ -1914,7 +1914,7 @@
lappend result [catch {foo bar} msg] $msg [namespace ensemble config foo]
rename foo {}
set result
-} {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo 0 {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo} {-map {} -namespace :: -prefixes 1 -subcommands {} -unknown bar}}
+} {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo 0 {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo} {-map {} -namespace :: -parameters {} -prefixes 1 -subcommands {} -unknown bar}}
test namespace-47.6 {ensemble: unknown handler} {
namespace ensemble create -command foo -unknown bar
proc bar {args} {
@@ -1981,7 +1981,7 @@
bar z 789
namespace delete foo
set result
-} {{-map {} -namespace ::foo -prefixes 1 -subcommands x -unknown ::foo::u} XXX 123 ::foo::bar {y 456} YYY 456 ::foo::bar {z 789} ZZZ 789}
+} {{-map {} -namespace ::foo -parameters {} -prefixes 1 -subcommands x -unknown ::foo::u} XXX 123 ::foo::bar {y 456} YYY 456 ::foo::bar {z 789} ZZZ 789}
test namespace-48.2 {ensembles and namespace import: exists} {
namespace eval foo {
namespace ensemble create -command ::foo::bar
@@ -2635,6 +2635,221 @@
namespace delete foo
} -result ok
+# TIP 314 - ensembles with parameters
+
+test namespace-53.1 {ensembles: parameters} {
+ namespace eval ns {
+ namespace export x
+ proc x {para} {list 1 $para}
+ namespace ensemble create -parameters {para1}
+ }
+ list [info command ns] [ns bar x] [namespace delete ns] [info command ns]
+} {ns {1 bar} {} {}}
+
+test namespace-53.2 {ensembles: parameters} -setup {
+ namespace eval ns {
+ namespace export x
+ proc x {para} {list 1 $para}
+ namespace ensemble create
+ }
+} -body {
+ namespace ensemble configure ns -parameters {para1}
+ rename ns foo
+ list [info command foo] [foo bar x] [namespace delete ns] [info command foo]
+} -result {foo {1 bar} {} {}}
+
+test namespace-53.3 {ensembles: parameters} -setup {
+ namespace eval ns {
+ namespace export x*
+ proc x1 {para} {list 1 $para}
+ proc x2 {para} {list 2 $para}
+ namespace ensemble create -parameters param1
+ }
+} -body {
+ set result [list [ns x2 x1] [ns x1 x2]]
+ lappend result [catch {ns x} msg] $msg
+ lappend result [catch {ns x x} msg] $msg
+ rename ns {}
+ lappend result [info command ns::x1]
+ namespace delete ns
+ lappend result [info command ns::x1]
+} -result\
+ {{1 x2} {2 x1}\
+ 1 {wrong # args: should be "ns param1 subcommand ?arg ...?"}\
+ 1 {unknown or ambiguous subcommand "x": must be x1, or x2}\
+ ::ns::x1 {}}
+
+test namespace-53.4 {ensembles: parameters} -setup {
+ namespace eval ns {
+ namespace export x*
+ proc x1 {a1 a2} {list 1 $a1 $a2}
+ proc x2 {a1 a2} {list 2 $a1 $a2}
+ proc x3 {a1 a2} {list 3 $a1 $a2}
+ namespace ensemble create
+ }
+} -body {
+ set result {}
+ lappend result [ns x1 x2 x3]
+ namespace ensemble configure ns -parameters p1
+ lappend result [ns x1 x2 x3]
+ namespace ensemble configure ns -parameters {p1 p2}
+ lappend result [ns x1 x2 x3]
+} -cleanup {
+ namespace delete ns
+} -result {{1 x2 x3} {2 x1 x3} {3 x1 x2}}
+
+test namespace-53.5 {ensembles: parameters} -setup {
+ namespace eval ns {
+ namespace export x*
+ proc x1 {para} {list 1 $para}
+ proc x2 {para} {list 2 $para}
+ proc x3 {para} {list 3 $para}
+ namespace ensemble create
+ }
+} -body {
+ set result [list [catch {ns x x1} msg] $msg]
+ lappend result [catch {ns x1 x} msg] $msg
+ namespace ensemble configure ns -parameters p1
+ lappend result [catch {ns x1 x} msg] $msg
+ lappend result [catch {ns x x1} msg] $msg
+} -cleanup {
+ namespace delete ns
+} -result\
+ {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}\
+ 0 {1 x}\
+ 1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}\
+ 0 {1 x}}
+
+test namespace-53.6 {ensembles: nested} -setup {
+ namespace eval ns {
+ namespace export x*
+ namespace eval x0 {
+ proc z {args} {list 0 $args}
+ namespace export z
+ namespace ensemble create
+ }
+ proc x1 {args} {list 1 $args}
+ proc x2 {args} {list 2 $args}
+ proc x3 {args} {list 3 $args}
+ namespace ensemble create -parameters p
+ }
+} -body {
+ list [ns z x0] [ns z x1] [ns z x2] [ns z x3]
+} -cleanup {
+ namespace delete ns
+} -result {{0 {}} {1 z} {2 z} {3 z}}
+
+test namespace-53.7 {ensembles: parameters & wrong # args} -setup {
+ namespace eval ns {
+ namespace export x*
+ proc x1 {a1 a2 a3 a4} {list x1 $a1 $a2 $a3 $a4}
+ namespace ensemble create -parameters p1
+ }
+} -body {
+ set result {}
+ lappend result [catch {ns} msg] $msg
+ lappend result [catch {ns x1} msg] $msg
+ lappend result [catch {ns x1 x1} msg] $msg
+ lappend result [catch {ns x1 x1 x1} msg] $msg
+ lappend result [catch {ns x1 x1 x1 x1} msg] $msg
+ lappend result [catch {ns x1 x1 x1 x1 x1} msg] $msg
+} -cleanup {
+ namespace delete ns
+} -result\
+ {1 {wrong # args: should be "ns p1 subcommand ?arg ...?"}\
+ 1 {wrong # args: should be "ns p1 subcommand ?arg ...?"}\
+ 1 {wrong # args: should be "ns x1 x1 a2 a3 a4"}\
+ 1 {wrong # args: should be "ns x1 x1 a2 a3 a4"}\
+ 1 {wrong # args: should be "ns x1 x1 a2 a3 a4"}\
+ 0 {x1 x1 x1 x1 x1}}
+
+test namespace-53.8 {ensemble: unknown handler changing -parameters} -setup {
+ namespace eval ns {
+ namespace export x*
+ proc x1 {a1} {list 1 $a1}
+ proc Magic {ensemble subcmd args} {
+ namespace ensemble configure $ensemble\
+ -parameters [lrange p1 [llength [
+ namespace ensemble configure $ensemble -parameters
+ ]] 0]
+ list
+ }
+ namespace ensemble create -unknown ::ns::Magic
+ }
+} -body {
+ set result {}
+ lappend result [catch {ns x1 x2} msg] $msg [namespace ensemble configure ns -parameters]
+ lappend result [catch {ns x2 x1} msg] $msg [namespace ensemble configure ns -parameters]
+ lappend result [catch {ns x2 x3} msg] $msg [namespace ensemble configure ns -parameters]
+} -cleanup {
+ namespace delete ns
+} -result\
+ {0 {1 x2} {}\
+ 0 {1 x2} p1\
+ 1 {unknown or ambiguous subcommand "x2": must be x1} {}}
+
+test namespace-53.9 {ensemble: unknown handler changing -parameters,\
+ thereby eating all args} -setup {
+ namespace eval ns {
+ namespace export x*
+ proc x1 {args} {list 1 $args}
+ proc Magic {ensemble subcmd args} {
+ namespace ensemble configure $ensemble\
+ -parameters {p1 p2 p3 p4 p5}
+ list
+ }
+ namespace ensemble create -unknown ::ns::Magic
+ }
+} -body {
+ set result {}
+ lappend result [catch {ns x1 x2} msg] $msg [namespace ensemble configure ns -parameters]
+ lappend result [catch {ns x2 x1} msg] $msg [namespace ensemble configure ns -parameters]
+ lappend result [catch {ns a1 a2 a3 a4 a5 x1} msg] $msg [namespace ensemble configure ns -parameters]
+} -cleanup {
+ namespace delete ns
+} -result\
+ {0 {1 x2} {}\
+ 1 {wrong # args: should be "ns p1 p2 p3 p4 p5 subcommand ?arg ...?"} {p1 p2 p3 p4 p5}\
+ 0 {1 {a1 a2 a3 a4 a5}} {p1 p2 p3 p4 p5}}
+
+test namespace-53.10 {ensembles: nested rewrite} -setup {
+ namespace eval ns {
+ namespace export x
+ namespace eval x {
+ proc z0 {} {list 0}
+ proc z1 {a1} {list 1 $a1}
+ proc z2 {a1 a2} {list 2 $a1 $a2}
+ proc z3 {a1 a2 a3} {list 3 $a1 $a2 $a3}
+ namespace export z*
+ namespace ensemble create
+ }
+ namespace ensemble create -parameters p
+ }
+} -body {
+ set result {}
+ # In these cases, parsing the subensemble does not grab a new word.
+ lappend result [catch {ns z0 x} msg] $msg
+ lappend result [catch {ns z1 x} msg] $msg
+ lappend result [catch {ns z2 x} msg] $msg
+ lappend result [catch {ns z2 x v} msg] $msg
+ namespace ensemble configure ns::x -parameters q1
+ # In these cases, parsing the subensemble grabs a new word.
+ lappend result [catch {ns v x z0} msg] $msg
+ lappend result [catch {ns v x z1} msg] $msg
+ lappend result [catch {ns v x z2} msg] $msg
+ lappend result [catch {ns v x z2 v2} msg] $msg
+} -cleanup {
+ namespace delete ns
+} -result\
+ {0 0\
+ 1 {wrong # args: should be "ns z1 x a1"}\
+ 1 {wrong # args: should be "ns z2 x a1 a2"}\
+ 1 {wrong # args: should be "ns z2 x a1 a2"}\
+ 1 {wrong # args: should be "::ns::x::z0"}\
+ 0 {1 v}\
+ 1 {wrong # args: should be "ns v x z2 a2"}\
+ 0 {2 v v2}}
+
# cleanup
catch {rename cmd1 {}}
catch {unset l}
