new test, and fix for bug

2 files changed, 39 insertions, 6 deletions

diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index dbc876a..7997efa 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -645,14 +645,8 @@ TclCompileCatchCmd(
 		(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
     }
 
-    /*
-     * Push the return options if the caller wants them.
-     */
-
     if (optsIndex != -1) {
 	TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
-	Emit14Inst(		INST_STORE_SCALAR, optsIndex,	envPtr);
-	TclEmitOpcode(		INST_POP,			envPtr);
     }
 
     /*
@@ -662,6 +656,15 @@ TclCompileCatchCmd(
     TclEmitOpcode(		INST_END_CATCH,			envPtr);
 
     /*
+     * Push the return options if the caller wants them.
+     */
+
+    if (optsIndex != -1) {
+	Emit14Inst(		INST_STORE_SCALAR, optsIndex,	envPtr);
+	TclEmitOpcode(		INST_POP,			envPtr);
+    }
+
+    /*
      * At this point, the top of the stack is inconveniently ordered:
      *		result returnCode
      * Reverse the stack to store the result.
diff --git a/tests/compile.test b/tests/compile.test
index 36e24de..2852bf2 100644
--- a/tests/compile.test
+++ b/tests/compile.test
@@ -167,6 +167,36 @@ test compile-3.6 {TclCompileCatchCmd: error in storing result [Bug 3098302]} {*}
     -cleanup {namespace delete catchtest}
 }
 
+test compile-3.7 {TclCompileCatchCmd: error in storing options [Bug 3098302]} {*}{
+     -setup {
+	 namespace eval catchtest {
+	     variable options1 {}
+	 }
+	 trace add variable catchtest::options1 write catchtest::failtrace
+	 proc catchtest::failtrace {n1 n2 op} {
+	     return -code error "trace on $n1 fails by request"
+	 }
+     }
+    -body {
+	proc catchtest::x {} {
+	    variable options1
+	    set count 0
+	    for {set i 0} {$i < 10} {incr i} {
+		set status2 [catch {
+		    set status1 [catch {
+			return -code error -level 0 "original failure"
+		    } result1 options1]
+		} result2 options2]
+		incr count
+	    }
+	    list $count $result2
+	}
+	catchtest::x
+    }
+    -result {10 {can't set "options1": trace on options1 fails by request}}
+    -cleanup {namespace delete catchtest}
+}
+
 test compile-4.1 {TclCompileForCmd: command substituted test expression} {
     set i 0
     set j 0