Improve the argument substitution behaviour of Tcl_WrongNumArgs when faced with

ensemble and interp-alias rewrites.

4 files changed, 80 insertions, 46 deletions

diff --git a/ChangeLog b/ChangeLog
index ae6d57e..3a71b72 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2007-06-12  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
+
+	* generic/tclIndexObj.c (Tcl_WrongNumArgs): 
+	* generic/tclNamesp.c, generic/tclInt.h (tclEnsembleCmdType): Make
+	Tcl_WrongNumArgs do replacement correctly with ensembles and other
+	sorts of complex replacement strategies.
+
 2007-06-11  Miguel Sofer  <msofer@users.sf.net>
 
 	* generic/tclExecute.c:  comments added to explain iPtr->numLevels
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;