summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2010-05-28 09:11:31 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2010-05-28 09:11:31 (GMT)
commit90238d516ef330d43c5795cf99c6d7f3cfa514fc (patch)
treeacc99d011b0d7d58f34c0c87315b5ff201f5002b
parent38420f3643011c20be92daaaa3957535dc0dfdb2 (diff)
downloadtcl-90238d516ef330d43c5795cf99c6d7f3cfa514fc.zip
tcl-90238d516ef330d43c5795cf99c6d7f3cfa514fc.tar.gz
tcl-90238d516ef330d43c5795cf99c6d7f3cfa514fc.tar.bz2
* generic/tclCompCmdsSZ.c (IssueTryFinallyInstructions): [3007374]:
Corrected error in handling of catch contexts to prevent crash with chained handlers.
-rw-r--r--ChangeLog4
-rw-r--r--generic/tclCompCmdsSZ.c102
-rw-r--r--tests/error.test19
3 files changed, 79 insertions, 46 deletions
diff --git a/ChangeLog b/ChangeLog
index a749a87..3bc5462 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
2010-05-28 Donal K. Fellows <dkf@users.sf.net>
+ * generic/tclCompCmdsSZ.c (IssueTryFinallyInstructions): [3007374]:
+ Corrected error in handling of catch contexts to prevent crash with
+ chained handlers.
+
* generic/tclExecute.c (TclExecuteByteCode): Restore correct operation
of instruction-level execution tracing (had been broken by NRE).
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index 3d45833..8fef58d 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompCmdsSZ.c,v 1.8 2010/04/08 13:26:24 dkf Exp $
+ * RCS: @(#) $Id: tclCompCmdsSZ.c,v 1.9 2010/05/28 09:11:31 dkf Exp $
*/
#include "tclInt.h"
@@ -2419,62 +2419,74 @@ IssueTryFinallyInstructions(
STORE( optionVars[i]);
OP( POP);
}
- }
- if (!handlerTokens[i]) {
+
+ if (!handlerTokens[i]) {
+ /*
+ * No handler. Will not be the last handler (that is a
+ * condition that is checked by the caller). Chain to the
+ * next one.
+ */
+
+ ExceptionRangeEnds(envPtr, range);
+ OP( END_CATCH);
+ forwardsNeedFixing = 1;
+ JUMP(forwardsToFix[i], JUMP4);
+ goto finishTrapCatchHandling;
+ }
+ } else if (!handlerTokens[i]) {
/*
* No handler. Will not be the last handler (that condition is
* checked by the caller). Chain to the next one.
*/
- ExceptionRangeEnds(envPtr, range);
forwardsNeedFixing = 1;
JUMP(forwardsToFix[i], JUMP4);
- if (resultVars[i] >= 0) {
- goto finishTrapCatchHandling;
- }
- } else {
- /*
- * Got a handler. Make sure that any pending patch-up actions
- * from previous unprocessed handlers are dealt with now that
- * we know where they are to jump to.
- */
+ goto endOfThisArm;
+ }
- if (forwardsNeedFixing) {
- forwardsNeedFixing = 0;
- OP1( JUMP1, 7);
- for (j=0 ; j<i ; j++) {
- if (forwardsToFix[j] == -1) {
- continue;
- }
- FIXJUMP(forwardsToFix[j]);
- forwardsToFix[j] = -1;
+ /*
+ * Got a handler. Make sure that any pending patch-up actions from
+ * previous unprocessed handlers are dealt with now that we know
+ * where they are to jump to.
+ */
+
+ if (forwardsNeedFixing) {
+ forwardsNeedFixing = 0;
+ OP1( JUMP1, 7);
+ for (j=0 ; j<i ; j++) {
+ if (forwardsToFix[j] == -1) {
+ continue;
}
- OP4( BEGIN_CATCH4, range);
+ FIXJUMP(forwardsToFix[j]);
+ forwardsToFix[j] = -1;
}
- BODY( handlerTokens[i], 5+i*4);
- ExceptionRangeEnds(envPtr, range);
- OP( PUSH_RETURN_OPTIONS);
- OP4( REVERSE, 2);
- OP1( JUMP1, 4);
- forwardsToFix[i] = -1;
+ OP4( BEGIN_CATCH4, range);
+ }
+ BODY( handlerTokens[i], 5+i*4);
+ ExceptionRangeEnds(envPtr, range);
+ OP( PUSH_RETURN_OPTIONS);
+ OP4( REVERSE, 2);
+ OP1( JUMP1, 4);
+ forwardsToFix[i] = -1;
- /*
- * Error in handler or setting of variables; replace the
- * stored exception with the new one. Note that we only push
- * this if we have either a body or some variable setting
- * here. Otherwise this code is unreachable.
- */
+ /*
+ * Error in handler or setting of variables; replace the stored
+ * exception with the new one. Note that we only push this if we
+ * have either a body or some variable setting here. Otherwise
+ * this code is unreachable.
+ */
- finishTrapCatchHandling:
- ExceptionRangeTarget(envPtr, range, catchOffset);
- OP( PUSH_RETURN_OPTIONS);
- OP( PUSH_RESULT);
- OP( END_CATCH);
- STORE( resultVar);
- OP( POP);
- STORE( optionsVar);
- OP( POP);
- }
+ finishTrapCatchHandling:
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ OP( PUSH_RETURN_OPTIONS);
+ OP( PUSH_RESULT);
+ OP( END_CATCH);
+ STORE( resultVar);
+ OP( POP);
+ STORE( optionsVar);
+ OP( POP);
+
+ endOfThisArm:
if (i+1 < numHandlers) {
JUMP(addrsToFix[i], JUMP4);
}
diff --git a/tests/error.test b/tests/error.test
index ef09bc5..1aab474 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.30 2010/04/05 19:44:45 ferrieux Exp $
+# RCS: @(#) $Id: error.test,v 1.31 2010/05/28 09:11:32 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -895,6 +895,23 @@ test error-19.9 {compiled try executes all clauses} -setup {
} -cleanup {
unset RES
} -result {a c d}
+test error-19.10 {compiled try with chained clauses} -setup {
+ set RES {}
+} -body {
+ list [apply {{} {
+ try {
+ return good
+ } on return {res} - on ok {res} {
+ addmsg ok
+ addmsg $res
+ return handler
+ } finally {
+ addmsg finally
+ }
+ } ::tcl::test::error}] $RES
+} -cleanup {
+ unset RES
+} -result {handler {ok good finally}}
rename addmsg {}
# FIXME test what vars get set on fallthough ... what is the correct behavior?