Improving tests, fixed one case.

2 files changed, 181 insertions, 36 deletions

diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index f166a7a..cbe36d1 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -92,10 +92,14 @@ const AuxDataType tclJumptableInfoType = {
     SetLineInformation((index));CompileBody(envPtr,(token),interp)
 #define PUSH(str) \
     PushStringLiteral(envPtr, str)
-#define JUMP(var,name) \
-    (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name,0,envPtr)
-#define FIXJUMP(var) \
+#define JUMP4(name,var) \
+    (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name##4,0,envPtr)
+#define FIXJUMP4(var) \
     TclStoreInt4AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
+#define JUMP1(name,var) \
+    (var) = CurrentOffset(envPtr);TclEmitInstInt1(INST_##name##1,0,envPtr)
+#define FIXJUMP1(var) \
+    TclStoreInt1AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
 #define LOAD(idx) \
     if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));}
 #define STORE(idx) \
@@ -2326,7 +2330,7 @@ IssueTryClausesInstructions(
     ExceptionRangeEnds(envPtr, range);
     if (!trapZero) {
 	OP(				END_CATCH);
-	JUMP(afterBody,			JUMP4);
+	JUMP4(				JUMP, afterBody);
 	TclAdjustStackDepth(-1, envPtr);
     } else {
 	PUSH(				"0");
@@ -2359,7 +2363,7 @@ IssueTryClausesInstructions(
 	OP(				DUP);
 	PushLiteral(envPtr, buf, strlen(buf));
 	OP(				EQ);
-	JUMP(notCodeJumpSource,		JUMP_FALSE4);
+	JUMP4(				JUMP_FALSE, notCodeJumpSource);
 	if (matchClauses[i]) {
 	    const char *p;
 	    Tcl_ListObjLength(NULL, matchClauses[i], &len);
@@ -2376,7 +2380,7 @@ IssueTryClausesInstructions(
 	    p = Tcl_GetStringFromObj(matchClauses[i], &len);
 	    PushLiteral(envPtr, p, len);
 	    OP(				STR_EQ);
-	    JUMP(notECJumpSource,	JUMP_FALSE4);
+	    JUMP4(			JUMP_FALSE, notECJumpSource);
 	} else {
 	    notECJumpSource = -1; /* LINT */
 	}
@@ -2400,7 +2404,7 @@ IssueTryClausesInstructions(
 	}
 	if (!handlerTokens[i]) {
 	    forwardsNeedFixing = 1;
-	    JUMP(forwardsToFix[i],	JUMP4);
+	    JUMP4(			JUMP, forwardsToFix[i]);
 	} else {
 	    forwardsToFix[i] = -1;
 	    if (forwardsNeedFixing) {
@@ -2409,7 +2413,7 @@ IssueTryClausesInstructions(
 		    if (forwardsToFix[j] == -1) {
 			continue;
 		    }
-		    FIXJUMP(forwardsToFix[j]);
+		    FIXJUMP4(forwardsToFix[j]);
 		    forwardsToFix[j] = -1;
 		}
 	    }
@@ -2417,11 +2421,11 @@ IssueTryClausesInstructions(
 	    BODY(			handlerTokens[i], 5+i*4);
 	}
 
-	JUMP(addrsToFix[i],		JUMP4);
+	JUMP4(				JUMP, addrsToFix[i]);
 	if (matchClauses[i]) {
-	    FIXJUMP(notECJumpSource);
+	    FIXJUMP4(	notECJumpSource);
 	}
-	FIXJUMP(notCodeJumpSource);
+	FIXJUMP4(	notCodeJumpSource);
     }
 
     /*
@@ -2441,10 +2445,10 @@ IssueTryClausesInstructions(
      */
 
     if (!trapZero) {
-	FIXJUMP(afterBody);
+	FIXJUMP4(afterBody);
     }
     for (i=0 ; i<numHandlers ; i++) {
-	FIXJUMP(addrsToFix[i]);
+	FIXJUMP4(addrsToFix[i]);
     }
     TclStackFree(interp, forwardsToFix);
     TclStackFree(interp, addrsToFix);
@@ -2508,7 +2512,7 @@ IssueTryClausesFinallyInstructions(
 	PUSH(				"-level 0 -code 0");
 	STORE(				optionsVar);
 	OP(				POP);
-	JUMP(afterBody,			JUMP4);
+	JUMP4(				JUMP, afterBody);
     } else {
 	PUSH(				"0");
 	OP4(				REVERSE, 2);
@@ -2542,7 +2546,7 @@ IssueTryClausesFinallyInstructions(
 	    OP(				DUP);
 	    PushLiteral(envPtr,	buf, strlen(buf));
 	    OP(				EQ);
-	    JUMP(notCodeJumpSource,	JUMP_FALSE4);
+	    JUMP4(			JUMP_FALSE, notCodeJumpSource);
 	    if (matchClauses[i]) {
 		const char *p;
 		Tcl_ListObjLength(NULL, matchClauses[i], &len);
@@ -2559,7 +2563,7 @@ IssueTryClausesFinallyInstructions(
 		p = Tcl_GetStringFromObj(matchClauses[i], &len);
 		PushLiteral(envPtr, p, len);
 		OP(			STR_EQ);
-		JUMP(notECJumpSource,	JUMP_FALSE4);
+		JUMP4(			JUMP_FALSE, notECJumpSource);
 	    } else {
 		notECJumpSource = -1; /* LINT */
 	    }
@@ -2596,7 +2600,7 @@ IssueTryClausesFinallyInstructions(
 		    ExceptionRangeEnds(envPtr, range);
 		    OP(			END_CATCH);
 		    forwardsNeedFixing = 1;
-		    JUMP(forwardsToFix[i], JUMP4);
+		    JUMP4(		JUMP, forwardsToFix[i]);
 		    goto finishTrapCatchHandling;
 		}
 	    } else if (!handlerTokens[i]) {
@@ -2606,7 +2610,7 @@ IssueTryClausesFinallyInstructions(
 		 */
 
 		forwardsNeedFixing = 1;
-		JUMP(forwardsToFix[i],	JUMP4);
+		JUMP4(			JUMP, forwardsToFix[i]);
 		goto endOfThisArm;
 	    }
 
@@ -2623,7 +2627,7 @@ IssueTryClausesFinallyInstructions(
 		    if (forwardsToFix[j] == -1) {
 			continue;
 		    }
-		    FIXJUMP(forwardsToFix[j]);
+		    FIXJUMP4(forwardsToFix[j]);
 		    forwardsToFix[j] = -1;
 		}
 		OP4(			BEGIN_CATCH4, range);
@@ -2655,12 +2659,12 @@ IssueTryClausesFinallyInstructions(
 
 	endOfThisArm:
 	    if (i+1 < numHandlers) {
-		JUMP(addrsToFix[i],	JUMP4);
+		JUMP4(			JUMP, addrsToFix[i]);
 	    }
 	    if (matchClauses[i]) {
-		FIXJUMP(notECJumpSource);
+		FIXJUMP4(notECJumpSource);
 	    }
-	    FIXJUMP(notCodeJumpSource);
+	    FIXJUMP4(notCodeJumpSource);
 	}
 
 	/*
@@ -2669,7 +2673,7 @@ IssueTryClausesFinallyInstructions(
 	 */
 
 	for (i=0 ; i<numHandlers-1 ; i++) {
-	    FIXJUMP(addrsToFix[i]);
+	    FIXJUMP4(addrsToFix[i]);
 	}
 	TclStackFree(interp, forwardsToFix);
 	TclStackFree(interp, addrsToFix);
@@ -2690,7 +2694,7 @@ IssueTryClausesFinallyInstructions(
      */
 
     if (!trapZero) {
-	FIXJUMP(afterBody);
+	FIXJUMP4(	afterBody);
     }
     envPtr->currStackDepth = savedStackDepth;
     BODY(				finallyToken, 3 + 4*numHandlers);
@@ -2711,7 +2715,7 @@ IssueTryFinallyInstructions(
     Tcl_Token *finallyToken)
 {
     DefineLineInformation;	/* TIP #280 */
-    int range;
+    int range, jumpOK, jumpSplice;
 
     /*
      * Note that this one is simple enough that we can issue it without
@@ -2734,15 +2738,28 @@ IssueTryFinallyInstructions(
     OP4(				BEGIN_CATCH4, range);
     ExceptionRangeStarts(envPtr, range);
     BODY(				finallyToken, 3);
+    ExceptionRangeEnds(envPtr, range);
     OP(					END_CATCH);
     OP(					POP);
-    OP1(				JUMP1, 3);
-    TclAdjustStackDepth(-1, envPtr);
+    JUMP1(				JUMP, jumpOK);
+    ExceptionRangeTarget(envPtr, range, catchOffset);
     OP(					PUSH_RESULT);
     OP(					PUSH_RETURN_OPTIONS);
     OP(					PUSH_RETURN_CODE);
     OP(					END_CATCH);
+    PUSH(				"1");
+    OP(					EQ);
+    JUMP1(				JUMP_FALSE, jumpSplice);
+    PUSH(				"-during");
+    OP4(				OVER, 3);
+    OP4(				LIST, 2);
+    OP(					LIST_CONCAT);
+    FIXJUMP1(		jumpSplice);
+    OP4(				REVERSE, 4);
+    OP(					POP);
     OP(					POP);
+    OP1(				JUMP1, 7);
+    FIXJUMP1(		jumpOK);
     OP4(				REVERSE, 2);
     OP(					RETURN_STK);
     return TCL_OK;
diff --git a/tests/error.test b/tests/error.test
index 97bcc0a..273577a 100644
--- a/tests/error.test
+++ b/tests/error.test
@@ -17,6 +17,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 }
 
 testConstraint memory [llength [info commands memory]]
+customMatch pairwise {apply {{a b} {
+    string equal [lindex $b 0] [lindex $b 1]
+}}}
 namespace eval ::tcl::test::error {
 if {[testConstraint memory]} {
     proc getbytes {} {
@@ -601,21 +604,21 @@ test error-16.7 {try with variable assignment and propagation #2} {
     }
     list $em [dict get $opts -errorcode]
 } {bar FOO}
-test error-16.8 {exception chaining (try=ok, handler=error)} {
+test error-16.8 {exception chaining (try=ok, handler=error)} -body {
     #FIXME is the intent of this test correct?
     catch {
 	try { list a b c } on ok {em opts} { throw BAR baz }
     } tryem tryopts
-    string equal $opts [dict get $tryopts -during]
-} {1}
-test error-16.9 {exception chaining (try=error, handler=error)} {
+    list $opts [dict get $tryopts -during]
+} -match pairwise -result equal
+test error-16.9 {exception chaining (try=error, handler=error)} -body {
     # The exception off the handler should chain to the exception off the
     # try-body (using the -during option)
     catch {
 	try { throw FOO bar } trap {} {em opts} { throw BAR baz }
     } tryem tryopts
-    string equal $opts [dict get $tryopts -during]
-} {1}
+    list $opts [dict get $tryopts -during]
+} -match pairwise -result equal
 test error-16.10 {no exception chaining when handler is successful} {
     catch {
 	try { throw FOO bar } trap {} {em opts} { list d e f }
@@ -628,6 +631,131 @@ test error-16.11 {no exception chaining when handler is a non-error exception} {
     } tryem tryopts
     dict exists $tryopts -during
 } {0}
+test error-16.12 {compiled try with successfully executed handler} {
+    apply {{} {
+	try { throw FOO bar } trap FOO {} { list a b c }
+    }}
+} {a b c}
+test error-16.13 {compiled try with exception (error) in handler} -body {
+    apply {{} {
+	try { throw FOO bar } trap FOO {} { throw BAR foo }
+    }}
+} -returnCodes error -result {foo}
+test error-16.14 {compiled try with exception (return) in handler} -body {
+    apply {{} {
+	list [catch {
+	    try { throw FOO bar } trap FOO {} { return BAR }
+	} msg] $msg
+    }}
+} -result {2 BAR}
+test error-16.15 {compiled try with exception (break) in handler} {
+    apply {{} {
+	for { set i 5 } { $i < 10 } { incr i } {
+	    try { throw FOO bar } trap FOO {} { break }
+	}
+	return $i
+    }}
+} {5}
+test error-16.16 {compiled try with exception (continue) in handler} {
+    apply {{} {
+	for { set i 5 } { $i < 10 } { incr i } {
+	    try { throw FOO bar } trap FOO {} { continue }
+	    incr i 20
+	}
+	return $i
+    }}
+} {10}
+test error-16.17 {compiled try with variable assignment and propagation #1} {
+    # Ensure that the handler variables preserve the exception off the
+    # try-body, and are not modified by the exception off the handler
+    apply {{} {
+	catch {
+	    try { throw FOO bar } trap FOO {em} { throw BAR baz }
+	}
+	return $em
+    }}
+} {bar}
+test error-16.18 {compiled try with variable assignment and propagation #2} {
+    apply {{} {
+	catch {
+	    try { throw FOO bar } trap FOO {em opts} { throw BAR baz }
+	}
+	list $em [dict get $opts -errorcode]
+    }}
+} {bar FOO}
+test error-16.19 {compiled try exception chaining (try=ok, handler=error)} -body {
+    #FIXME is the intent of this test correct?
+    apply {{} {
+	catch {
+	    try { list a b c } on ok {em opts} { throw BAR baz }
+	} tryem tryopts
+	list $opts [dict get $tryopts -during]
+    }}
+} -match pairwise -result equal
+test error-16.20 {compiled try exception chaining (try=error, handler=error)} -body {
+    # The exception off the handler should chain to the exception off the
+    # try-body (using the -during option)
+    apply {{} {
+	catch {
+	    try { throw FOO bar } trap {} {em opts} { throw BAR baz }
+	} tryem tryopts
+	list $opts [dict get $tryopts -during]
+    }}
+} -match pairwise -result equal
+test error-16.21 {compiled try exception chaining (try=error, finally=error)} {
+    # The exception off the handler should chain to the exception off the
+    # try-body (using the -during option)
+    apply {{} {
+	catch {
+	    try { throw FOO bar } finally { throw BAR baz }
+	} tryem tryopts
+	dict get $tryopts -during -errorcode
+    }}
+} FOO
+test error-16.22 {compiled try: no exception chaining when handler is successful} {
+    apply {{} {
+	catch {
+	    try { throw FOO bar } trap {} {em opts} { list d e f }
+	} tryem tryopts
+	dict exists $tryopts -during
+    }}
+} {0}
+test error-16.23 {compiled try: no exception chaining when handler is a non-error exception} {
+    apply {{} {
+	catch {
+	    try { throw FOO bar } trap {} {em opts} { break }
+	} tryem tryopts
+	dict exists $tryopts -during
+    }}
+} {0}
+test error-16.24 {compiled try exception chaining (try=ok, handler=error, finally=error)} -body {
+    apply {{} {
+	catch {
+	    try {
+		list a b c
+	    } on ok {em opts} {
+		throw BAR baz
+	    } finally {
+		throw DING dong
+	    }
+	} tryem tryopts
+	list $opts [dict get $tryopts -during -during]
+    }}
+} -match pairwise -result equal
+test error-16.25 {compiled try exception chaining (all errors)} -body {
+    apply {{} {
+	catch {
+	    try {
+		throw FOO bar
+	    } on error {em opts} {
+		throw BAR baz
+	    } finally {
+		throw DING dong
+	    }
+	} tryem tryopts
+	list $opts [dict get $tryopts -during -during]
+    }}
+} -match pairwise -result equal
 
 # try tests - finally
 
@@ -709,15 +837,15 @@ test error-18.5 {exception in finally doesn't affect variable assignment} {
     }
     list $em [dict get $opts -errorcode]
 } {bar FOO}
-test error-18.6 {exception chaining in finally (try=ok)} {
+test error-18.6 {exception chaining in finally (try=ok)} -body {
     catch {
 	list a b c
     } em expopts
     catch {
 	try { list a b c } finally { throw BAR foo }
     } em opts
-    string equal $expopts [dict get $opts -during]
-} {1}
+    list $expopts [dict get $opts -during]
+} -match pairwise -result equal
 test error-18.7 {exception chaining in finally (try=error)} {
     catch {
 	try { throw FOO bar } finally { throw BAR baz }