diff options
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclInterp.c | 8 | ||||
| -rw-r--r-- | generic/tclProc.c | 47 |
3 files changed, 44 insertions, 16 deletions
@@ -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; } /* |