summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2010-11-03 11:08:20 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2010-11-03 11:08:20 (GMT)
commitd4d95330eb4e444b9ed5cbdfbad4fa6e887fd2b9 (patch)
tree544fadeed0b36a19c7d51de61efce0a1365c09ab
parent4ac4e5c0f9920027f560c0c6234a8249f8724ec5 (diff)
downloadtcl-d4d95330eb4e444b9ed5cbdfbad4fa6e887fd2b9.zip
tcl-d4d95330eb4e444b9ed5cbdfbad4fa6e887fd2b9.tar.gz
tcl-d4d95330eb4e444b9ed5cbdfbad4fa6e887fd2b9.tar.bz2
* 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.
-rw-r--r--ChangeLog37
-rw-r--r--generic/tclCmdMZ.c4
-rw-r--r--tests/error.test46
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?