summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2007-06-12 12:29:03 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2007-06-12 12:29:03 (GMT)
commitbf56a09707e69cf1c2ca8a5cec6617c0dca24d57 (patch)
tree77dcc03631a20a577c5de5bd77c2012af285e413 /generic
parent8dd53a8ad1790646d8c1a51fba684de5b75a4321 (diff)
downloadtcl-bf56a09707e69cf1c2ca8a5cec6617c0dca24d57.zip
tcl-bf56a09707e69cf1c2ca8a5cec6617c0dca24d57.tar.gz
tcl-bf56a09707e69cf1c2ca8a5cec6617c0dca24d57.tar.bz2
Improve the argument substitution behaviour of Tcl_WrongNumArgs when faced with
ensemble and interp-alias rewrites.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclIndexObj.c29
-rw-r--r--generic/tclInt.h24
-rw-r--r--generic/tclNamesp.c66
3 files changed, 73 insertions, 46 deletions
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index af0b444..df8d9ee 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIndexObj.c,v 1.32 2007/04/02 18:48:03 dgp Exp $
+ * RCS: @(#) $Id: tclIndexObj.c,v 1.33 2007/06/12 12:29:05 dkf Exp $
*/
#include "tclInt.h"
@@ -449,7 +449,6 @@ Tcl_WrongNumArgs(
{
Tcl_Obj *objPtr;
int i, len, elemLen, flags;
- register IndexRep *indexRep;
Interp *iPtr = (Interp *) interp;
char *elementStr;
@@ -521,11 +520,25 @@ Tcl_WrongNumArgs(
* Add the element, quoting it if necessary.
*/
- elementStr = Tcl_GetStringFromObj(origObjv[i], &elemLen);
+ if (origObjv[i]->typePtr == &indexType) {
+ register IndexRep *indexRep =
+ origObjv[i]->internalRep.otherValuePtr;
+
+ elementStr = EXPAND_OF(indexRep);
+ elemLen = strlen(elementStr);
+ } else if (origObjv[i]->typePtr == &tclEnsembleCmdType) {
+ register EnsembleCmdRep *ecrPtr =
+ origObjv[i]->internalRep.otherValuePtr;
+
+ elementStr = ecrPtr->fullSubcmdName;
+ elemLen = strlen(elementStr);
+ } else {
+ elementStr = Tcl_GetStringFromObj(origObjv[i], &elemLen);
+ }
len = Tcl_ScanCountedElement(elementStr, elemLen, &flags);
if (MAY_QUOTE_WORD && len != elemLen) {
- char *quotedElementStr = TclStackAlloc(interp, (unsigned) len);
+ char *quotedElementStr = TclStackAlloc(interp, (unsigned)len);
len = Tcl_ConvertCountedElement(elementStr, elemLen,
quotedElementStr, flags);
@@ -562,8 +575,14 @@ Tcl_WrongNumArgs(
*/
if (objv[i]->typePtr == &indexType) {
- indexRep = (IndexRep *) objv[i]->internalRep.otherValuePtr;
+ register IndexRep *indexRep = objv[i]->internalRep.otherValuePtr;
+
Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
+ } else if (objv[i]->typePtr == &tclEnsembleCmdType) {
+ register EnsembleCmdRep *ecrPtr =
+ objv[i]->internalRep.otherValuePtr;
+
+ Tcl_AppendStringsToObj(objPtr, ecrPtr->fullSubcmdName, NULL);
} else {
/*
* Quote the argument if it contains spaces (Bug 942757).
diff --git a/generic/tclInt.h b/generic/tclInt.h
index f3c7c5e..8b015b0 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.316 2007/06/10 20:25:55 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.317 2007/06/12 12:29:05 dkf Exp $
*/
#ifndef _TCLINT
@@ -357,6 +357,27 @@ struct NamespacePathEntry {
#define TCL_FIND_ONLY_NS 0x1000
/*
+ * The data cached in an ensemble subcommand's Tcl_Obj rep (reference in
+ * otherValuePtr field). This structure is not shared between Tcl_Objs
+ * referring to the same subcommand, even where one is a duplicate of another.
+ */
+
+typedef struct {
+ Namespace *nsPtr; /* The namespace backing the ensemble which
+ * this is a subcommand of. */
+ int epoch; /* Used to confirm when the data in this
+ * really structure matches up with the
+ * ensemble. */
+ Tcl_Command token; /* Reference to the comamnd for which this
+ * structure is a cache of the resolution. */
+ char *fullSubcmdName; /* The full (local) name of the subcommand,
+ * allocated with ckalloc(). */
+ Tcl_Obj *realPrefixObj; /* Object containing the prefix words of the
+ * command that implements this ensemble
+ * subcommand. */
+} EnsembleCmdRep;
+
+/*
*----------------------------------------------------------------
* Data structures related to variables. These are used primarily in tclVar.c
*----------------------------------------------------------------
@@ -2195,6 +2216,7 @@ MODULE_SCOPE Tcl_ObjType tclProcBodyType;
MODULE_SCOPE Tcl_ObjType tclStringType;
MODULE_SCOPE Tcl_ObjType tclArraySearchType;
MODULE_SCOPE Tcl_ObjType tclNsNameType;
+MODULE_SCOPE Tcl_ObjType tclEnsembleCmdType;
#ifndef NO_WIDE_TYPE
MODULE_SCOPE Tcl_ObjType tclWideIntType;
#endif
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index f674a01..ba64680 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.138 2007/06/11 23:00:44 msofer Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.139 2007/06/12 12:29:06 dkf Exp $
*/
#include "tclInt.h"
@@ -154,27 +154,6 @@ typedef struct EnsembleConfig {
* and on its way out. */
/*
- * The data cached in a subcommand's Tcl_Obj rep. This structure is not shared
- * between Tcl_Objs referring to the same subcommand, even where one is a
- * duplicate of another.
- */
-
-typedef struct EnsembleCmdRep {
- Namespace *nsPtr; /* The namespace backing the ensemble which
- * this is a subcommand of. */
- int epoch; /* Used to confirm when the data in this
- * really structure matches up with the
- * ensemble. */
- Tcl_Command token; /* Reference to the comamnd for which this
- * structure is a cache of the resolution. */
- char *fullSubcmdName; /* The full (local) name of the subcommand,
- * allocated with ckalloc(). */
- Tcl_Obj *realPrefixObj; /* Object containing the prefix words of the
- * command that implements this ensemble
- * subcommand. */
-} EnsembleCmdRep;
-
-/*
* Declarations for functions local to this file:
*/
@@ -275,7 +254,7 @@ Tcl_ObjType tclNsNameType = {
* that implements it.
*/
-static Tcl_ObjType ensembleCmdType = {
+Tcl_ObjType tclEnsembleCmdType = {
"ensembleCommand", /* the type's name */
FreeEnsembleCmdRep, /* freeIntRepProc */
DupEnsembleCmdRep, /* dupIntRepProc */
@@ -6152,14 +6131,14 @@ NsEnsembleImplementationCmd(
if (ensemblePtr->epoch == ensemblePtr->nsPtr->exportLookupEpoch) {
/*
* Table of subcommands is still valid; therefore there might be a
- * valid cache of discovered information which we can reuse. Do the
- * check here, and if we're still valid, we can jump straight to the
- * part where we do the invocation of the subcommand.
+ * valid cache of discovered information which we can reuse. Do
+ * the check here, and if we're still valid, we can jump straight
+ * to the part where we do the invocation of the subcommand.
*/
- if (objv[1]->typePtr == &ensembleCmdType) {
+ if (objv[1]->typePtr == &tclEnsembleCmdType) {
EnsembleCmdRep *ensembleCmd = (EnsembleCmdRep *)
- objv[1]->internalRep.otherValuePtr;
+ objv[1]->internalRep.otherValuePtr;
if (ensembleCmd->nsPtr == ensemblePtr->nsPtr &&
ensembleCmd->epoch == ensemblePtr->epoch &&
ensembleCmd->token == ensemblePtr->token) {
@@ -6179,33 +6158,40 @@ NsEnsembleImplementationCmd(
* 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
+ * in which it is guaranteed to exist, but we don't do
* that (the cacheing of the command object used should
- * help with that.)
+ * help with that.)
*/
iPtr = (Interp *) interp;
- isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
+ isRootEnsemble =
+ (iPtr->ensembleRewrite.sourceObjs == NULL);
copyObj = TclListObjCopy(NULL, prefixObj);
- Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
+ Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc,
+ &prefixObjv);
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;
+ iPtr->ensembleRewrite.numInsertedObjs +=
+ prefixObjc - 1;
} else {
- iPtr->ensembleRewrite.numInsertedObjs += prefixObjc - 2;
+ iPtr->ensembleRewrite.numInsertedObjs +=
+ prefixObjc - 2;
}
}
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));
+ (int) sizeof(Tcl_Obj*) * (objc - 2 + prefixObjc));
+ memcpy(tempObjv, prefixObjv,
+ sizeof(Tcl_Obj *) * prefixObjc);
+ memcpy(tempObjv+prefixObjc, objv+2,
+ sizeof(Tcl_Obj *) * (objc-2));
result = Tcl_EvalObjv(interp, objc-2+prefixObjc, tempObjv,
TCL_EVAL_INVOKE);
Tcl_DecrRefCount(copyObj);
@@ -6475,7 +6461,7 @@ MakeCachedEnsembleCommand(
register EnsembleCmdRep *ensembleCmd;
int length;
- if (objPtr->typePtr == &ensembleCmdType) {
+ if (objPtr->typePtr == &tclEnsembleCmdType) {
ensembleCmd = (EnsembleCmdRep *) objPtr->internalRep.otherValuePtr;
Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
ensembleCmd->nsPtr->refCount--;
@@ -6493,7 +6479,7 @@ MakeCachedEnsembleCommand(
TclFreeIntRep(objPtr);
ensembleCmd = (EnsembleCmdRep *) ckalloc(sizeof(EnsembleCmdRep));
objPtr->internalRep.otherValuePtr = (void *) ensembleCmd;
- objPtr->typePtr = &ensembleCmdType;
+ objPtr->typePtr = &tclEnsembleCmdType;
}
/*
@@ -6925,7 +6911,7 @@ DupEnsembleCmdRep(
ckalloc(sizeof(EnsembleCmdRep));
int length = strlen(ensembleCmd->fullSubcmdName);
- copyPtr->typePtr = &ensembleCmdType;
+ copyPtr->typePtr = &tclEnsembleCmdType;
copyPtr->internalRep.otherValuePtr = (void *) ensembleCopy;
ensembleCopy->nsPtr = ensembleCmd->nsPtr;
ensembleCopy->epoch = ensembleCmd->epoch;