Attachment "ensemble-parameters.patch" to
ticket [1901783fff]
added by
lars_h
2008-02-26 07:34:19.
Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.129
diff -c -r1.129 tcl.decls
*** generic/tcl.decls 13 Dec 2007 15:23:14 -0000 1.129
--- generic/tcl.decls 25 Feb 2008 23:06:48 -0000
***************
*** 2099,2104 ****
--- 2099,2115 ----
void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr, CONST char *format, ...)
}
+ # TIP xxx Ensembles with parameters
+ declare 580 generic {
+ int Tcl_SetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token,
+ Tcl_Obj *paramList)
+ }
+ declare 581 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/tclDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v
retrieving revision 1.130
diff -c -r1.130 tclDecls.h
*** generic/tclDecls.h 13 Dec 2007 15:23:16 -0000 1.130
--- generic/tclDecls.h 25 Feb 2008 23:06:56 -0000
***************
*** 3501,3506 ****
--- 3501,3518 ----
EXTERN void Tcl_AppendPrintfToObj (Tcl_Obj * objPtr,
CONST char * format, ...);
#endif
+ #ifndef Tcl_SetEnsembleParameterList_TCL_DECLARED
+ #define Tcl_SetEnsembleParameterList_TCL_DECLARED
+ /* 580 */
+ EXTERN int Tcl_SetEnsembleParameterList (Tcl_Interp * interp,
+ Tcl_Command token, Tcl_Obj * paramList);
+ #endif
+ #ifndef Tcl_GetEnsembleParameterList_TCL_DECLARED
+ #define Tcl_GetEnsembleParameterList_TCL_DECLARED
+ /* 581 */
+ EXTERN int Tcl_GetEnsembleParameterList (Tcl_Interp * interp,
+ Tcl_Command token, Tcl_Obj ** paramListPtr);
+ #endif
typedef struct TclStubHooks {
struct TclPlatStubs *tclPlatStubs;
***************
*** 4140,4145 ****
--- 4152,4159 ----
int (*tcl_AppendFormatToObj) (Tcl_Interp * interp, Tcl_Obj * objPtr, CONST char * format, int objc, Tcl_Obj * CONST objv[]); /* 577 */
Tcl_Obj * (*tcl_ObjPrintf) (CONST char * format, ...); /* 578 */
void (*tcl_AppendPrintfToObj) (Tcl_Obj * objPtr, CONST char * format, ...); /* 579 */
+ int (*tcl_SetEnsembleParameterList) (Tcl_Interp * interp, Tcl_Command token, Tcl_Obj * paramList); /* 580 */
+ int (*tcl_GetEnsembleParameterList) (Tcl_Interp * interp, Tcl_Command token, Tcl_Obj ** paramListPtr); /* 581 */
} TclStubs;
#ifdef __cplusplus
***************
*** 6536,6541 ****
--- 6550,6563 ----
#define Tcl_AppendPrintfToObj \
(tclStubsPtr->tcl_AppendPrintfToObj) /* 579 */
#endif
+ #ifndef Tcl_SetEnsembleParameterList
+ #define Tcl_SetEnsembleParameterList \
+ (tclStubsPtr->tcl_SetEnsembleParameterList) /* 580 */
+ #endif
+ #ifndef Tcl_GetEnsembleParameterList
+ #define Tcl_GetEnsembleParameterList \
+ (tclStubsPtr->tcl_GetEnsembleParameterList) /* 581 */
+ #endif
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.161
diff -c -r1.161 tclNamesp.c
*** generic/tclNamesp.c 13 Dec 2007 15:23:19 -0000 1.161
--- generic/tclNamesp.c 25 Feb 2008 23:07:05 -0000
***************
*** 111,119 ****
--- 111,121 ----
* 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,149 ****
--- 146,154 ----
#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:
*/
***************
*** 4745,4760 ****
ENS_CONFIG, ENS_CREATE, ENS_EXISTS
};
static const char *createOptions[] = {
! "-command", "-map", "-prefixes", "-subcommands", "-unknown", NULL
};
enum EnsCreateOpts {
! CRT_CMD, CRT_MAP, CRT_PREFIX, CRT_SUBCMDS, CRT_UNKNOWN
};
static const char *configOptions[] = {
! "-map", "-namespace", "-prefixes", "-subcommands", "-unknown", NULL
};
enum EnsConfigOpts {
! CONF_MAP, CONF_NAMESPACE, CONF_PREFIX, CONF_SUBCMDS, CONF_UNKNOWN
};
int index;
--- 4750,4769 ----
ENS_CONFIG, ENS_CREATE, ENS_EXISTS
};
static const char *createOptions[] = {
! "-command", "-map", "-parameters", "-prefixes", "-subcommands",
! "-unknown", NULL
};
enum EnsCreateOpts {
! CRT_CMD, CRT_MAP, CRT_PARAM, CRT_PREFIX, CRT_SUBCMDS,
! CRT_UNKNOWN
};
static const char *configOptions[] = {
! "-map", "-namespace", "-parameters", "-prefixes", "-subcommands",
! "-unknown", NULL
};
enum EnsConfigOpts {
! CONF_MAP, CONF_NAMESPACE, CONF_PARAM, CONF_PREFIX, CONF_SUBCMDS,
! CONF_UNKNOWN
};
int index;
***************
*** 4789,4794 ****
--- 4798,4804 ----
Tcl_Obj *mapObj = NULL;
int permitPrefix = 1;
Tcl_Obj *unknownObj = NULL;
+ Tcl_Obj *paramObj = NULL;
objv += 3;
objc -= 3;
***************
*** 4829,4834 ****
--- 4839,4853 ----
}
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;
***************
*** 4935,4940 ****
--- 4954,4960 ----
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
***************
*** 4980,4985 ****
--- 5000,5011 ----
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) {
***************
*** 5037,5042 ****
--- 5063,5075 ----
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));
***************
*** 5064,5075 ****
Tcl_DictSearch search;
Tcl_Obj *listObj;
int done, len, allocatedMapFlag = 0;
! Tcl_Obj *subcmdObj = NULL, *mapObj = 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_GetEnsembleUnknownHandler(NULL, token, &unknownObj);
Tcl_GetEnsembleFlags(NULL, token, &flags);
permitPrefix = (flags & TCL_ENSEMBLE_PREFIX) != 0;
--- 5097,5109 ----
Tcl_DictSearch search;
Tcl_Obj *listObj;
int done, len, allocatedMapFlag = 0;
! 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;
***************
*** 5102,5107 ****
--- 5136,5150 ----
}
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;
***************
*** 5211,5216 ****
--- 5254,5260 ----
: 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;
***************
*** 5277,5282 ****
--- 5321,5328 ----
ensemblePtr->subcmdList = NULL;
ensemblePtr->subcommandDict = NULL;
ensemblePtr->flags = flags;
+ ensemblePtr->numParameters = 0;
+ ensemblePtr->parameterList = NULL;
ensemblePtr->unknownHandler = NULL;
ensemblePtr->token = Tcl_CreateObjCommand(interp, name,
NsEnsembleImplementationCmd, ensemblePtr, DeleteEnsembleConfig);
***************
*** 5378,5383 ****
--- 5424,5505 ----
/*
*----------------------------------------------------------------------
*
+ * 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.
***************
*** 5650,5655 ****
--- 5772,5817 ----
/*
*----------------------------------------------------------------------
*
+ * 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
***************
*** 6015,6026 ****
int prefixObjc; /* Size of prefixObjv of course! */
int reparseCount = 0; /* Number of reparses. */
! if (objc < 2) {
! Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument ...?");
return TCL_ERROR;
}
- restartEnsembleParse:
if (ensemblePtr->nsPtr->flags & NS_DYING) {
/*
* Don't know how we got here, but make things give up quickly.
--- 6177,6215 ----
int prefixObjc; /* Size of prefixObjv of course! */
int reparseCount = 0; /* Number of reparses. */
! restartEnsembleParse:
! /*
! * Must recheck objc, since numParameters may 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 ?argument ...?", -1);
! Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf));
! Tcl_DStringFree(&buf);
!
return TCL_ERROR;
}
if (ensemblePtr->nsPtr->flags & NS_DYING) {
/*
* Don't know how we got here, but make things give up quickly.
***************
*** 6046,6053 ****
* part where we do the invocation of the subcommand.
*/
! if (objv[1]->typePtr == &tclEnsembleCmdType) {
! EnsembleCmdRep *ensembleCmd = objv[1]->internalRep.otherValuePtr;
if (ensembleCmd->nsPtr == ensemblePtr->nsPtr &&
ensembleCmd->epoch == ensemblePtr->epoch &&
--- 6235,6243 ----
* part where we do the invocation of the subcommand.
*/
! if (objv[1 + ensemblePtr->numParameters]->typePtr == &tclEnsembleCmdType) {
! EnsembleCmdRep *ensembleCmd =
! objv[1 + ensemblePtr->numParameters]->internalRep.otherValuePtr;
if (ensembleCmd->nsPtr == ensemblePtr->nsPtr &&
ensembleCmd->epoch == ensemblePtr->epoch &&
***************
*** 6068,6074 ****
*/
hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable,
! TclGetString(objv[1]));
if (hPtr != NULL) {
char *fullName = Tcl_GetHashKey(&ensemblePtr->subcommandTable, hPtr);
--- 6258,6264 ----
*/
hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable,
! TclGetString(objv[1 + ensemblePtr->numParameters]));
if (hPtr != NULL) {
char *fullName = Tcl_GetHashKey(&ensemblePtr->subcommandTable, hPtr);
***************
*** 6078,6084 ****
* Cache for later in the subcommand object.
*/
! MakeCachedEnsembleCommand(objv[1], ensemblePtr, fullName, prefixObj);
} else if (!(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX)) {
/*
* Could not map, no prefixing, go to unknown/error handling.
--- 6268,6275 ----
* Cache for later in the subcommand object.
*/
! 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.
***************
*** 6099,6106 ****
int stringLength, i;
int tableLength = ensemblePtr->subcommandTable.numEntries;
! subcmdName = TclGetString(objv[1]);
! stringLength = objv[1]->length;
for (i=0 ; i<tableLength ; i++) {
register int cmp = strncmp(subcmdName,
ensemblePtr->subcommandArrayPtr[i],
--- 6290,6297 ----
int stringLength, i;
int tableLength = ensemblePtr->subcommandTable.numEntries;
! 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],
***************
*** 6146,6152 ****
* Cache for later in the subcommand object.
*/
! MakeCachedEnsembleCommand(objv[1], ensemblePtr, fullName, prefixObj);
}
Tcl_IncrRefCount(prefixObj);
--- 6337,6344 ----
* Cache for later in the subcommand object.
*/
! MakeCachedEnsembleCommand(objv[1 + ensemblePtr->numParameters],
! ensemblePtr, fullName, prefixObj);
}
Tcl_IncrRefCount(prefixObj);
***************
*** 6158,6164 ****
* 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
* that (the cacheing of the command object used should help with that.)
*/
--- 6350,6360 ----
* 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,
! *
! * ((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.)
*/
***************
*** 6180,6197 ****
/*
* Record what arguments the script sent in so that things like
* Tcl_WrongNumArgs can give the correct error message.
*/
isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
if (isRootEnsemble) {
iPtr->ensembleRewrite.sourceObjs = objv;
! iPtr->ensembleRewrite.numRemovedObjs = 2;
! iPtr->ensembleRewrite.numInsertedObjs = prefixObjc;
} else {
! int ni = iPtr->ensembleRewrite.numInsertedObjs;
!
! if (ni < 2) {
! iPtr->ensembleRewrite.numRemovedObjs += 2 - ni;
iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1;
} else {
iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2;
--- 6376,6396 ----
/*
* 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.
*/
isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
if (isRootEnsemble) {
iPtr->ensembleRewrite.sourceObjs = objv;
! iPtr->ensembleRewrite.numRemovedObjs = 2 + ensemblePtr->numParameters;
! iPtr->ensembleRewrite.numInsertedObjs = prefixObjc + ensemblePtr->numParameters;
} else {
! 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;
***************
*** 6206,6212 ****
tempObjv = (Tcl_Obj **) TclStackAlloc(interp,
(int) sizeof(Tcl_Obj *) * (objc - 2 + prefixObjc));
memcpy(tempObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
! memcpy(tempObjv+prefixObjc, objv+2, sizeof(Tcl_Obj *) * (objc-2));
/*
* Hand off to the target command.
--- 6405,6415 ----
tempObjv = (Tcl_Obj **) TclStackAlloc(interp,
(int) sizeof(Tcl_Obj *) * (objc - 2 + prefixObjc));
memcpy(tempObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
! memcpy(tempObjv+prefixObjc, objv+1,
! sizeof(Tcl_Obj *) * ensemblePtr->numParameters);
! memcpy(tempObjv+prefixObjc+ensemblePtr->numParameters,
! objv+ensemblePtr->numParameters+2,
! sizeof(Tcl_Obj *) * (objc-ensemblePtr->numParameters-2));
/*
* Hand off to the target command.
***************
*** 6334,6351 ****
Tcl_ResetResult(interp);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
! TclGetString(objv[1]), NULL);
if (ensemblePtr->subcommandTable.numEntries == 0) {
! Tcl_AppendResult(interp, "unknown subcommand \"",TclGetString(objv[1]),
"\": namespace ", ensemblePtr->nsPtr->fullName,
" does not export any commands", NULL);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
! TclGetString(objv[1]), NULL);
return TCL_ERROR;
}
Tcl_AppendResult(interp, "unknown ",
(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? "or ambiguous " : ""),
! "subcommand \"", TclGetString(objv[1]), "\": must be ", NULL);
if (ensemblePtr->subcommandTable.numEntries == 1) {
Tcl_AppendResult(interp, ensemblePtr->subcommandArrayPtr[0], NULL);
} else {
--- 6537,6556 ----
Tcl_ResetResult(interp);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
! TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
if (ensemblePtr->subcommandTable.numEntries == 0) {
! 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+ensemblePtr->numParameters]), NULL);
return TCL_ERROR;
}
Tcl_AppendResult(interp, "unknown ",
(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? "or ambiguous " : ""),
! "subcommand \"", TclGetString(objv[1+ensemblePtr->numParameters]),
! "\": must be ", NULL);
if (ensemblePtr->subcommandTable.numEntries == 1) {
Tcl_AppendResult(interp, ensemblePtr->subcommandArrayPtr[0], NULL);
} else {
***************
*** 6359,6365 ****
ensemblePtr->subcommandArrayPtr[i], NULL);
}
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
! TclGetString(objv[1]), NULL);
return TCL_ERROR;
}
--- 6564,6570 ----
ensemblePtr->subcommandArrayPtr[i], NULL);
}
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
! TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
return TCL_ERROR;
}
***************
*** 6502,6507 ****
--- 6707,6715 ----
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: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.150
diff -c -r1.150 tclStubInit.c
*** generic/tclStubInit.c 23 Jan 2008 17:31:42 -0000 1.150
--- generic/tclStubInit.c 25 Feb 2008 23:07:08 -0000
***************
*** 1128,1133 ****
--- 1128,1135 ----
Tcl_AppendFormatToObj, /* 577 */
Tcl_ObjPrintf, /* 578 */
Tcl_AppendPrintfToObj, /* 579 */
+ Tcl_SetEnsembleParameterList, /* 580 */
+ Tcl_GetEnsembleParameterList, /* 581 */
};
/* !END!: Do not edit above this line. */
Index: tests/namespace.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/namespace.test,v
retrieving revision 1.70
diff -c -r1.70 namespace.test
*** tests/namespace.test 13 Dec 2007 15:26:06 -0000 1.70
--- tests/namespace.test 25 Feb 2008 23:07:12 -0000
***************
*** 1696,1702 ****
}
namespace delete ns
set result
! } {-map {} -namespace ::ns -prefixes 1 -subcommands {} -unknown {}}
test namespace-45.2 {ensemble: introspection} {
namespace eval ns {
namespace export x
--- 1696,1702 ----
}
namespace delete ns
set result
! } {-map {} -namespace ::ns -parameters {} -prefixes 1 -subcommands {} -unknown {}}
test namespace-45.2 {ensemble: introspection} {
namespace eval ns {
namespace export x
***************
*** 1910,1916 ****
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}}
test namespace-47.6 {ensemble: unknown handler} {
namespace ensemble create -command foo -unknown bar
proc bar {args} {
--- 1910,1916 ----
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 :: -parameters {} -prefixes 1 -subcommands {} -unknown bar}}
test namespace-47.6 {ensemble: unknown handler} {
namespace ensemble create -command foo -unknown bar
proc bar {args} {
***************
*** 1977,1983 ****
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}
test namespace-48.2 {ensembles and namespace import: exists} {
namespace eval foo {
namespace ensemble create -command ::foo::bar
--- 1977,1983 ----
bar z 789
namespace delete foo
set result
! } {{-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
***************
*** 2619,2625 ****
rename unknown.save ::unknown
namespace eval :: [list namespace unknown $handler]
} -result SUCCESS
!
# cleanup
catch {rename cmd1 {}}
catch {unset l}
--- 2619,2840 ----
rename unknown.save ::unknown
namespace eval :: [list namespace unknown $handler]
} -result SUCCESS
!
! # TIP xxx - 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 ?argument ...?"}\
! 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 ?argument ...?"}\
! 1 {wrong # args: should be "ns p1 subcommand ?argument ...?"}\
! 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 ?argument ...?"} {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}
