summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2006-03-10 19:49:13 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2006-03-10 19:49:13 (GMT)
commite7c6e0ca85731660713714016acde44d23e78e30 (patch)
tree47aec5ab19d9564687f1427738d2bb9f032fe4e8
parent123a450f1b884cd20b6fb652c77f83fd20844a2f (diff)
downloadtcl-e7c6e0ca85731660713714016acde44d23e78e30.zip
tcl-e7c6e0ca85731660713714016acde44d23e78e30.tar.gz
tcl-e7c6e0ca85731660713714016acde44d23e78e30.tar.bz2
* generic/tclProc.c (ObjInterpProcEx):
* tests/apply.test (apply-5.1): fix [apply] error messages so that they quote the lambda expression [Bug 1447355].
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclProc.c19
-rw-r--r--tests/apply.test4
3 files changed, 25 insertions, 4 deletions
diff --git a/ChangeLog b/ChangeLog
index 2562c74..98288c7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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"}}