* generic/tclProc.c (ApplyObjCmd): fix wrong#args for apply by

	using the ensemble rewrite engine, [Bug 1574835].
	* generic/tclInterp.c (AliasObjCmd): previous commit missed usage
	of TCL_EVAL_NOREWRITE for aliases.

3 files changed, 44 insertions, 16 deletions

diff --git a/ChangeLog b/ChangeLog
index 7dd12be..0f7f7dc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,10 @@
 2006-10-23  Miguel Sofer  <msofer@users.sf.net>
 
+	* generic/tclProc.c (ApplyObjCmd): fix wrong#args for apply by
+	using the ensemble rewrite engine, [Bug 1574835].
+	* generic/tclInterp.c (AliasObjCmd): previous commit missed usage
+	of TCL_EVAL_NOREWRITE for aliases.
+
 	* generic/tclBasic.c (TclEvalObjvInternal): removed redundant
 	check for ensembles [Bug 1577628].
 	
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 60e6eb6..9de1fbd 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.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: tclInterp.c,v 1.64 2006/10/17 15:39:24 msofer Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.65 2006/10/24 00:29:30 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1740,10 +1740,12 @@ AliasObjCmd(
     
     if (targetInterp != interp) {
 	Tcl_Preserve((ClientData) targetInterp);
-	result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE);
+	result = Tcl_EvalObjv(targetInterp, cmdc, cmdv,
+		TCL_EVAL_INVOKE|TCL_EVAL_NOREWRITE);
 	TclTransferResult(targetInterp, result, interp);
     } else {
-	result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE);
+	result = Tcl_EvalObjv(targetInterp, cmdc, cmdv,
+		TCL_EVAL_INVOKE|TCL_EVAL_NOREWRITE);
     }
 
     if (isRootEnsemble) {
diff --git a/generic/tclProc.c b/generic/tclProc.c
index b0df000..b2ff2b9 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -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: tclProc.c,v 1.97 2006/10/23 22:49:25 msofer Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.98 2006/10/24 00:29:31 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -29,7 +29,7 @@ static void		InitCompiledLocals(Tcl_Interp *interp,
 			    Var *varPtr, Namespace *nsPtr);
 static int		ObjInterpProcEx(ClientData clientData,
 			    register Tcl_Interp *interp, int objc,
-			    Tcl_Obj *CONST objv[], int skip);
+			    Tcl_Obj *CONST objv[], int isLambda);
 static void		ProcBodyDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
 static void		ProcBodyFree(Tcl_Obj *objPtr);
 static int		ProcessProcResultCode(Tcl_Interp *interp,
@@ -1136,7 +1136,7 @@ TclObjInterpProc(
     Tcl_Obj *CONST objv[])	/* Argument value objects. */
 {
 
-    return ObjInterpProcEx(clientData, interp, objc, objv, /*skip*/ 1);
+    return ObjInterpProcEx(clientData, interp, objc, objv, /*isLambda*/ 0);
 }
 	
 static int
@@ -1148,8 +1148,8 @@ ObjInterpProcEx(
     int objc,			/* Count of number of arguments to this
 				 * procedure. */
     Tcl_Obj *CONST objv[],	/* Argument value objects. */
-    int skip)			/* Number of initial arguments to be skipped,
-				 * ie, words in the "command name" */ 
+    int isLambda)		/* 1 if this is a call by ApplyObjCmd: it
+				 * needs special rules for error msg */ 
 {
     Proc *procPtr = (Proc *) clientData;
     Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
@@ -1219,8 +1219,8 @@ ObjInterpProcEx(
      */
 
     numArgs = procPtr->numArgs;
-    argCt = objc-skip; /* set it to the number of args to the proc */
-    argObjs = &objv[skip];
+    argCt = objc-1; /* set it to the number of args to the proc */
+    argObjs = &objv[1];
     varPtr = framePtr->compiledLocals;
     localPtr = procPtr->firstLocalPtr;
     if (numArgs == 0) {
@@ -1316,7 +1316,7 @@ ObjInterpProcEx(
 #ifdef AVOID_HACKS_FOR_ITCL
 	desiredObjs[0] = objv[0];
 #else
-	desiredObjs[0] = Tcl_NewListObj(skip, objv);
+	desiredObjs[0] = Tcl_NewListObj(1, objv);
 #endif /* AVOID_HACKS_FOR_ITCL */
 
 	localPtr = procPtr->firstLocalPtr;
@@ -1397,21 +1397,25 @@ ObjInterpProcEx(
     }
 
     if (result != TCL_OK) {
-	if (skip == 1) {
-	    result = ProcessProcResultCode(interp, procName, nameLen, result);
-	} else {
+	if (isLambda) {
 	    /*
 	     * Use a 'procName' that contains the first skip elements of objv
 	     * for error reporting. This insures that we do not see just
 	     * 'apply', but also the lambda expression that caused the error.
+	     *
+	     * NASTY HACK: looks one object back in objv - it was skipped by
+	     * ApplyObjCmd. Temporary solution, the whole thing needs
+	     * refactoring. 
 	     */
 	     
 	    Tcl_Obj *namePtr;
 
-	    namePtr = Tcl_NewListObj(skip, objv);
+	    namePtr = Tcl_NewListObj(2, objv-1);
 	    procName = Tcl_GetStringFromObj(namePtr, &nameLen);
 	    result = ProcessProcResultCode(interp, procName, nameLen, result);
 	    TclDecrRefCount(namePtr);
+	} else {
+	    result = ProcessProcResultCode(interp, procName, nameLen, result);	    
 	}
     }
 
@@ -2079,6 +2083,7 @@ Tcl_ApplyObjCmd(
     int result;
     Command cmd;
     Tcl_Namespace *nsPtr;
+    int isRootEnsemble;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "lambdaExpr ?arg1 arg2 ...?");
@@ -2144,7 +2149,23 @@ Tcl_ApplyObjCmd(
     
     cmd.nsPtr = (Namespace *) nsPtr;
 
-    return ObjInterpProcEx((ClientData) procPtr, interp, objc, objv, 2);
+    isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
+    if (isRootEnsemble) {
+	iPtr->ensembleRewrite.sourceObjs = objv;
+	iPtr->ensembleRewrite.numRemovedObjs = 1;
+	iPtr->ensembleRewrite.numInsertedObjs = 0;
+    } else {
+	iPtr->ensembleRewrite.numInsertedObjs -= 1;
+    }
+
+    result = ObjInterpProcEx((ClientData) procPtr, interp, objc-1, objv+1,1);
+
+    if (isRootEnsemble) {
+	iPtr->ensembleRewrite.sourceObjs = NULL;
+	iPtr->ensembleRewrite.numRemovedObjs = 0;
+	iPtr->ensembleRewrite.numInsertedObjs = 0;
+    }
+    return result;    
 }
 
 /*