diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclProc.c | 19 | ||||
| -rw-r--r-- | tests/apply.test | 4 |
3 files changed, 25 insertions, 4 deletions
@@ -1,3 +1,9 @@ +2006-03-10 Miguel Sofer <msofer@users.sf.net> + + * generic/tclProc.c (ObjInterpProcEx): + * tests/apply.test (apply-5.1): fix [apply] error messages + so that they quote the lambda expression [Bug 1447355]. + 2006-03-10 Zoran Vasiljevic <vasiljevic@users.sourceforge.net> -- Summary of changes fixing Tcl Bug #1437595 -- diff --git a/generic/tclProc.c b/generic/tclProc.c index 1627f2e..beb3d48 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.87 2006/02/02 10:45:07 dkf Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.88 2006/03/10 19:49:14 msofer Exp $ */ #include "tclInt.h" @@ -1405,7 +1405,22 @@ ObjInterpProcEx( } if (result != TCL_OK) { - result = ProcessProcResultCode(interp, procName, nameLen, result); + if (skip == 1) { + result = ProcessProcResultCode(interp, procName, nameLen, result); + } else { + /* + * 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. + */ + + Tcl_Obj *namePtr; + + namePtr = Tcl_NewListObj(skip, objv); + procName = Tcl_GetStringFromObj(namePtr, &nameLen); + result = ProcessProcResultCode(interp, procName, nameLen, result); + TclDecrRefCount(namePtr); + } } /* diff --git a/tests/apply.test b/tests/apply.test index 9f619bf..a4e5b8c 100644 --- a/tests/apply.test +++ b/tests/apply.test @@ -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: apply.test,v 1.4 2006/02/09 16:53:29 dgp Exp $ +# RCS: @(#) $Id: apply.test,v 1.5 2006/03/10 19:49:14 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -132,7 +132,7 @@ test apply-5.1 {runtime error in lambda expression} { } {1 {foo while executing "error foo" - (procedure "apply" line 1) CHECK & MODIFY + (procedure "apply {{} {error foo}}" line 1) invoked from within "apply $lambda"}} |