* generic/tclExecute.c (TclExecuteByteCode): When an

	error is encountered reading the increment value during
	a compiled call to incr, add a "(reading increment)"
	error string to the errorInfo variable. This makes
	the errorInfo variable set by the compiled incr command
	match the value set by the non-compiled version.
	* tests/incr-old.test: Change errorInfo result for
	the compiled incr command case to match the modified
	implementation.
	* tests/incr.test: Add tests to make sure the compiled
	and non-compiled errorInfo messages are the same.

4 files changed, 34 insertions, 4 deletions

diff --git a/ChangeLog b/ChangeLog
index 93c0849..8289c1e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2003-02-06  Mo DeJong  <mdejong@users.sourceforge.net>
+
+	* generic/tclExecute.c (TclExecuteByteCode): When an
+	error is encountered reading the increment value during
+	a compiled call to incr, add a "(reading increment)"
+	error string to the errorInfo variable. This makes
+	the errorInfo variable set by the compiled incr command
+	match the value set by the non-compiled version.
+	* tests/incr-old.test: Change errorInfo result for
+	the compiled incr command case to match the modified
+	implementation.
+	* tests/incr.test: Add tests to make sure the compiled
+	and non-compiled errorInfo messages are the same.
+
 2003-02-06  Don Porter  <dgp@users.sourceforge.net>
 
 	* library/tcltest/tcltest.tcl:  Filename arguments to [outputChannel]
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index ef7797b..93bf3a9 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.91 2003/01/08 21:29:06 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.92 2003/02/06 22:44:57 mdejong Exp $
  */
 
 #include "tclInt.h"
@@ -1918,6 +1918,7 @@ TclExecuteByteCode(interp, codePtr)
 	    if (result != TCL_OK) {
 		TRACE_WITH_OBJ(("%u (by %s) => ERROR converting increment amount to int: ",
 		        opnd, O2S(valuePtr)), Tcl_GetObjResult(interp));
+		Tcl_AddErrorInfo(interp, "\n    (reading increment)");
 		goto checkForCatch;
 	    }
 	    FORCE_LONG(valuePtr, i, w);
diff --git a/tests/incr-old.test b/tests/incr-old.test
index 0344c42..1c78b82 100644
--- a/tests/incr-old.test
+++ b/tests/incr-old.test
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: incr-old.test,v 1.5 2000/04/10 17:19:00 ericm Exp $
+# RCS: @(#) $Id: incr-old.test,v 1.6 2003/02/06 22:44:58 mdejong Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -62,7 +62,8 @@ test incr-old-2.5 {incr errors} {
     set x 123
     list [catch {incr x 1a} msg] $msg $errorInfo
 } {1 {expected integer but got "1a"} {expected integer but got "1a"
-    while executing
+    (reading increment)
+    invoked from within
 "incr x 1a"}}
 test incr-old-2.6 {incr errors} {
     proc readonly args {error "variable is read-only"}
diff --git a/tests/incr.test b/tests/incr.test
index f3ea408..1aeea59 100644
--- a/tests/incr.test
+++ b/tests/incr.test
@@ -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: incr.test,v 1.6 2000/04/10 17:19:00 ericm Exp $
+# RCS: @(#) $Id: incr.test,v 1.7 2003/02/06 22:44:58 mdejong Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -502,6 +502,20 @@ test incr-2.29 {incr command (not compiled): runtime error, bad variable value}
     set x "  -  "
     list [catch {$z x 1} msg] $msg
 } {1 {expected integer but got "  -  "}}
+test incr-2.30 {incr command (not compiled): bad increment} {
+    set z incr
+    set x 0
+    list [catch {$z x 1a} msg] $msg $errorInfo
+} {1 {expected integer but got "1a"} {expected integer but got "1a"
+    (reading increment)
+    invoked from within
+"$z x 1a"}}
+test incr-2.31 {incr command (compiled): bad increment} {
+    list [catch {incr x 1a} msg] $msg $errorInfo
+} {1 {expected integer but got "1a"} {expected integer but got "1a"
+    (reading increment)
+    invoked from within
+"incr x 1a"}}
 
 # cleanup
 ::tcltest::cleanupTests