From 90238d516ef330d43c5795cf99c6d7f3cfa514fc Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 28 May 2010 09:11:31 +0000
Subject: 	* generic/tclCompCmdsSZ.c (IssueTryFinallyInstructions):
 [3007374]: 	Corrected error in handling of catch contexts to prevent crash
 with 	chained handlers.

---
 ChangeLog               |   4 ++
 generic/tclCompCmdsSZ.c | 102 +++++++++++++++++++++++++++---------------------
 tests/error.test        |  19 ++++++++-
 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?
-- 
cgit v0.12