From e7c6e0ca85731660713714016acde44d23e78e30 Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Fri, 10 Mar 2006 19:49:13 +0000
Subject: 	* generic/tclProc.c (ObjInterpProcEx): 	* tests/apply.test
 (apply-5.1): fix [apply] error messages 	so that they quote the lambda
 expression [Bug 1447355].

---
 ChangeLog         |  6 ++++++
 generic/tclProc.c | 19 +++++++++++++++++--
 tests/apply.test  |  4 ++--
 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"}}
 
-- 
cgit v0.12