* generic/tclCmdMZ.c (TryPostBody): Ensure that errors when setting

	* tests/error.test (error-19.1[12]): message/opt capture variables get
					     reflected properly to the caller.


FossilOrigin-Name: 24c6bb8619a935f39e0c6bf2137eceddf138dbdd

3 files changed, 70 insertions, 17 deletions

diff --git a/ChangeLog b/ChangeLog
index 7d90381..af082ba 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,18 +1,23 @@
+2010-11-03  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclCmdMZ.c (TryPostBody):  Ensure that errors when setting
+	* tests/error.test (error-19.1[12]): message/opt capture variables get
+					     reflected properly to the caller.
+
 2010-11-03  Kevin B. Kenny  <kennykb@acm.org>
 
-	* generic/tclCompCmds.c (TclCompileCatchCmd):
-	* tests/compile.test (compile-3,6): Reworked the compilation of
-	the [catch] command so as to avoid placing any code that might
-	throw an exception (specifically, any initial substitutions
-	or any stores to result or options variables) between the
-	BEGIN_CATCH and END_CATCH but outside the exception range.
-	Added a test case that panics on a stack smash if the change
-	is not made. [Bug #3098302]
+	* generic/tclCompCmds.c (TclCompileCatchCmd): [Bug 3098302]:
+	* tests/compile.test (compile-3,6): Reworked the compilation of the
+	[catch] command so as to avoid placing any code that might throw an
+	exception (specifically, any initial substitutions or any stores to
+	result or options variables) between the BEGIN_CATCH and END_CATCH but
+	outside the exception range.  Added a test case that panics on a stack
+	smash if the change is not made.
 
 2010-11-01  Stuart Cassoff  <stwo@users.sourceforge.net>
 
-	* library/safe.tcl:	Improved handling of non-standard module
-	* tests/safe.test:	path lists, empty path lists in particular.
+	* library/safe.tcl:	Improved handling of non-standard module path
+	* tests/safe.test:	lists, empty path lists in particular.
 
 2010-11-01  Kevin B. Kenny  <kennykb@acm.org>
 
@@ -22,15 +27,17 @@
 
 2010-10-29  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>
 
-	* generic/tclTimer.c:	Stop small [afters] from wasting CPU [Bug
-				2905784] while keeping accuracy.
+	* generic/tclTimer.c:	[Bug 2905784]: Stop small [after]s from
+				wasting CPU while keeping accuracy.
 
 2010-10-28  Don Porter  <dgp@users.sourceforge.net>
 
-	* tests/http.test:	Make http-4.15 pass in isolation [Bug 3097490]
+	* tests/http.test:	[Bug 3097490]: Make http-4.15 pass in
+				isolation.
 
-	* unix/tclUnixSock.c:	Prevent calls freeaddrinfo(NULL) which can
-	crash some systems.  Thanks Larry Virden.  [Bug 3093120]
+	* unix/tclUnixSock.c:	[Bug 3093120]: Prevent calls of
+				freeaddrinfo(NULL) which can crash some
+				systems.  Thanks Larry Virden.
 
 2010-10-26  Reinhard Max  <max@suse.de>
 
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 7690649..fbe8eac 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -15,7 +15,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.214 2010/08/30 14:02:09 msofer Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.215 2010/11/03 11:08:21 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -4499,6 +4499,8 @@ TryPostBody(
 		    ((Interp *) interp)->cmdFramePtr, 4*i + 5);
 
 	handlerFailed:
+	    resultObj = Tcl_GetObjResult(interp);
+	    Tcl_IncrRefCount(resultObj);
 	    options = During(interp, result, options, NULL);
 	    break;
 
diff --git a/tests/error.test b/tests/error.test
index 6e2aee5..77a96fd 100644
--- a/tests/error.test
+++ b/tests/error.test
@@ -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: error.test,v 1.34 2010/10/20 20:52:28 ferrieux Exp $
+# RCS: @(#) $Id: error.test,v 1.35 2010/11/03 11:08:21 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -912,6 +912,50 @@ test error-19.10 {compiled try with chained clauses} -setup {
 } -cleanup {
     unset RES
 } -result {handler {ok good finally}}
+test error-19.11 {compiled try and errors on variable write} -setup {
+    set RES {}
+} -body {
+    apply {{} {
+	array set foo {bar boo}
+	set bar unset
+	catch {
+	    try {
+		addmsg body
+		return a
+	    } on return {bar foo} {
+		addmsg handler
+		return b
+	    } finally {
+		addmsg finally,$bar
+	    }
+	} msg
+	addmsg $msg
+    } ::tcl::test::error}
+} -cleanup {
+    unset RES
+} -result {body finally,a {can't set "foo": variable is array}}
+test error-19.12 {interpreted try and errors on variable write} -setup {
+    set RES {}
+} -body {
+    apply {try {
+	array set foo {bar boo}
+	set bar unset
+	catch {
+	    $try {
+		addmsg body
+		return a
+	    } on return {bar foo} {
+		addmsg handler
+		return b
+	    } finally {
+		addmsg finally,$bar
+	    }
+	} msg
+	addmsg $msg
+    } ::tcl::test::error} try
+} -cleanup {
+    unset RES
+} -result {body finally,a {can't set "foo": variable is array}}
 rename addmsg {}
 
 # FIXME test what vars get set on fallthough ... what is the correct behavior?