summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog8
-rw-r--r--generic/tclAssembly.c323
-rw-r--r--tests/assemble.test77
3 files changed, 318 insertions, 90 deletions
diff --git a/ChangeLog b/ChangeLog
index 47d5caa..dc2f494 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2010-12-15 Kevin B. Kenny <kennykb@acm.org>
+
+ * tclAssembly.c:
+ * assemble.test: Reworked beginCatch/endCatch handling to
+ enforce the more severe (but more correct) restrictions on catch
+ handling that appeared in the discussion of [Bug 3098302] and in
+ tcl-core traffic beginning about 2010-10-29.
+
2010-12-10 Jan Nijtmans <nijtmans@users.sf.net>
* generic/tcl.h: [Bug 3129448]: Possible over-allocation on
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 1b12987..26372c6 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclAssembly.c,v 1.1.2.17 2010/10/28 19:40:12 kennykb Exp $
+ * RCS: @(#) $Id: tclAssembly.c,v 1.1.2.18 2010/12/16 01:40:42 kennykb Exp $
*/
/*-
@@ -47,9 +47,6 @@ typedef enum BasicBlockCatchState {
BBCS_UNKNOWN = 0, /* Catch context has not yet been identified */
BBCS_NONE, /* Block is outside of any catch */
BBCS_INCATCH, /* Block is within a catch context */
- BBCS_DONECATCH, /* Block is nominally within a catch context
- * but has passed a 'doneCatch' directive
- * and wants exceptions to propagate. */
BBCS_CAUGHT, /* Block is within a catch context and
* may be executed after an exception fires */
} BasicBlockCatchState;
@@ -81,8 +78,7 @@ typedef struct BasicBlock {
struct BasicBlock * successor1;
/* BasicBlock structure of the following
* block: NULL at the end of the bytecode
- * sequence or if the block ends in an
- * unconditional jump */
+ * sequence. */
Tcl_Obj * jumpTarget; /* Jump target label if the jump target
* is unresolved */
@@ -128,11 +124,7 @@ enum BasicBlockFlags {
* marking it as the start of a 'catch'
* sequence. The 'jumpTarget' is the exception
* exit from the catch block. */
- BB_DONECATCH = (1 << 5), /* Block commences with a 'doneCatch'
- * directive, indicating that the program
- * is finished with the body of a catch block.
- */
- BB_ENDCATCH = (1 << 6), /* Block ends with an 'endCatch' instruction,
+ BB_ENDCATCH = (1 << 5), /* Block ends with an 'endCatch' instruction,
* unwinding the catch from the exception
* stack. */
};
@@ -156,9 +148,6 @@ typedef enum TalInstType {
ASSEM_DICT_UNSET,
/* specifies key count and LVT index, consumes N operands,
* produces 1, N > 0 */
- ASSEM_DONECATCH,/* Directive indicating that the body of a catch block
- * is complete. Generates no instructions, affects only
- * the exception ranges. */
ASSEM_END_CATCH,/* End catch. No args. Exception range popped from stack
* and stack pointer restored. */
ASSEM_EVAL, /* 'eval' - evaluate a constant script (by compiling it
@@ -253,6 +242,9 @@ static void BBEmitOpcode(AssemblyEnv* assemEnvPtr, int tblind, int count);
static int BuildExceptionRanges(AssemblyEnv* assemEnvPtr);
static int CalculateJumpRelocations(AssemblyEnv*, int*);
static int CheckForUnclosedCatches(AssemblyEnv*);
+static int CheckForThrowInWrongContext(AssemblyEnv*);
+static int CheckNonThrowingBlock(AssemblyEnv*, BasicBlock*);
+static int BytecodeMightThrow(unsigned char);
static int CheckJumpTableLabels(AssemblyEnv*, BasicBlock*);
static int CheckNamespaceQualifiers(Tcl_Interp*, const char*, int);
static int CheckNonNegative(Tcl_Interp*, int);
@@ -333,6 +325,10 @@ static const Tcl_ObjType assembleCodeType = {
#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */
+/*
+ * Source instructions recognized in the Tcl Assembly Language (TAL)
+ */
+
TalInstDesc TalInstructionTable[] = {
/* PUSH must be first, see the code near the end of TclAssembleCode */
@@ -363,7 +359,6 @@ TalInstDesc TalInstructionTable[] = {
{"dictUnset", ASSEM_DICT_UNSET,
INST_DICT_UNSET, INT_MIN,1},
{"div", ASSEM_1BYTE, INST_DIV, 2, 1},
- {"doneCatch", ASSEM_DONECATCH,0, 0, 0},
{"dup", ASSEM_1BYTE , INST_DUP , 1 , 2},
{"endCatch", ASSEM_END_CATCH,INST_END_CATCH, 0, 0},
{"eq", ASSEM_1BYTE , INST_EQ , 2 , 1},
@@ -466,6 +461,24 @@ TalInstDesc TalInstructionTable[] = {
{"variable", ASSEM_LVT4, INST_VARIABLE, 1, 0},
{NULL, 0, 0, 0, 0}
};
+
+/*
+ * List of instructions that cannot throw an exception under any circumstances.
+ * These instructions are the ones that are permissible after an exception
+ * is caught but before the corresponding exception range is popped from
+ * the stack.
+ * The instructions must be in ascending order by numeric operation code.
+ */
+
+static unsigned char NonThrowingByteCodes[] = {
+ INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP, /* 1-4 */
+ INST_JUMP1, INST_JUMP4, /* 34-35 */
+ INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 70-72 */
+ INST_OVER, /* 95 */
+ INST_PUSH_RETURN_OPTIONS, /* 108 */
+ INST_REVERSE, /* 126 */
+ INST_NOP /* 132 */
+};
/*
*-----------------------------------------------------------------------------
@@ -1290,11 +1303,6 @@ AssembleOneLine(AssemblyEnv* assemEnvPtr)
TclEmitInt4(localVar, envPtr);
break;
- case ASSEM_DONECATCH:
- StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);
- assemEnvPtr->curr_bb->flags |= BB_DONECATCH;
- break;
-
case ASSEM_END_CATCH:
if (parsePtr->numWords != 1) {
Tcl_WrongNumArgs(interp, 1, &instNameObj, "");
@@ -2572,6 +2580,15 @@ FinishAssembly(AssemblyEnv* assemEnvPtr)
return TCL_ERROR;
}
+ /*
+ * Make sure that no block accessible from a catch's error exit that hasn't
+ * popped the exception stack can throw an exception.
+ */
+
+ if (CheckForThrowInWrongContext(assemEnvPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
/* Compute stack balance throughout the program */
if (CheckStack(assemEnvPtr) != TCL_OK) {
@@ -2959,6 +2976,168 @@ ResolveJumpTableTargets(AssemblyEnv* assemEnvPtr,
/*
*-----------------------------------------------------------------------------
*
+ * CheckForThrowInWrongContext --
+ *
+ * Verify that no beginCatch/endCatch sequence can throw an exception
+ * after an original exception is caught and before its exception
+ * context is removed from the stack.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * Stores an appropriate error message in the interpreter as needed.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckForThrowInWrongContext(AssemblyEnv* assemEnvPtr)
+ /* Assembler environment */
+{
+ BasicBlock* blockPtr; /* Current basic block */
+
+ /*
+ * Walk through the basic blocks in turn, checking all the ones
+ * that have caught an exception and not disposed of it properly.
+ */
+
+ for (blockPtr = assemEnvPtr->head_bb;
+ blockPtr != NULL;
+ blockPtr = blockPtr->successor1) {
+
+ if (blockPtr->catchState == BBCS_CAUGHT) {
+
+ /* Walk through the instructions in the basic block */
+
+ if (CheckNonThrowingBlock(assemEnvPtr, blockPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * CheckNonThrowingBlock --
+ *
+ * Check that a basic block cannot throw an exception.
+ *
+ * Results:
+ * Returns TCL_ERROR if the block cannot be proven to be nonthrowing.
+ *
+ * Side effects:
+ * Stashes an error message in the interpreter result.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+CheckNonThrowingBlock(AssemblyEnv* assemEnvPtr,
+ /* Assembler environment */
+ BasicBlock* blockPtr)
+ /* Basic block where exceptions are
+ * not allowed */
+{
+ CompileEnv* envPtr = assemEnvPtr->envPtr;
+ /* Compilation environment */
+ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
+ /* Tcl interpreter */
+ BasicBlock* nextPtr; /* Pointer to the succeeding basic block */
+ int offset; /* Bytecode offset of the current instruction */
+ int bound; /* Bytecode offset following the last
+ * instruction of the block. */
+ unsigned char opcode; /* Current bytecode instruction */
+ Tcl_Obj* retval; /* Error message */
+
+ /* Determine where in the code array the basic block ends */
+
+ nextPtr = blockPtr->successor1;
+ if (nextPtr == NULL) {
+ bound = envPtr->codeNext - envPtr->codeStart;
+ } else {
+ bound = nextPtr->startOffset;
+ }
+
+ /* Walk through the instructions of the block */
+
+ offset = blockPtr->startOffset;
+ while (offset < bound) {
+
+ /* Determine whether an instruction is nonthrowing */
+
+ opcode = (envPtr->codeStart)[offset];
+
+ if (BytecodeMightThrow(opcode)) {
+
+ /* Report an error for a throw in the wrong context */
+
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ retval = Tcl_NewStringObj("\"", -1);
+ Tcl_AppendToObj(retval, tclInstructionTable[opcode].name,
+ -1);
+ Tcl_AppendToObj(retval, "\" instruction may not appear in "
+ "a context where an exception has been "
+ "caught and not disposed of.", -1);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADTHROW", NULL);
+ Tcl_SetObjResult(interp, retval);
+ AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
+ }
+ return TCL_ERROR;
+ }
+ offset += tclInstructionTable[opcode].numBytes;
+ }
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * BytecodeMightThrow --
+ *
+ * Tests if a given bytecode instruction might throw an exception.
+ *
+ * Results:
+ * Returns 1 if the bytecode might throw an exception, 0 if the
+ * instruction is known never to throw.
+ *
+ *-----------------------------------------------------------------------------
+ */
+
+static int
+BytecodeMightThrow(unsigned char opcode)
+{
+
+ /* Binary search on the non-throwing bytecode list */
+
+ int min = 0;
+ int max = sizeof(NonThrowingByteCodes)-1;
+ int mid;
+ unsigned char c;
+ while (max >= min) {
+ mid = (min + max) / 2;
+ c = NonThrowingByteCodes[mid];
+ if (opcode < c) {
+ max = mid-1;
+ } else if (opcode > c) {
+ min = mid+1;
+ } else {
+
+ /* Opcode is nonthrowing */
+
+ return 0;
+ }
+ }
+
+ return 1;
+}
+
+/*
+ *-----------------------------------------------------------------------------
+ *
* CheckStack --
*
* Audit stack usage in a block of assembly code.
@@ -3084,13 +3263,15 @@ StackCheckBasicBlock(AssemblyEnv* assemEnvPtr,
* If the block is not already visited, set the 'predecessor'
* link to indicate how control got to it. Set the initial stack
* depth to the current stack depth in the flow of control.
- * Calculate max and min stack depth, flag an error if the
- * block underflows the stack, and update max stack depth in the
- * assembly environment.
*/
blockPtr->flags |= BB_VISITED;
blockPtr->predecessor = predecessor;
blockPtr->initialStackDepth = initialStackDepth;
+
+ /*
+ * Calculate minimum stack depth, and flag an error if the block
+ * underflows the stack.
+ */
if (initialStackDepth + blockPtr->minStackDepth < 0) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp,
@@ -3101,6 +3282,29 @@ StackCheckBasicBlock(AssemblyEnv* assemEnvPtr,
}
return TCL_ERROR;
}
+
+ /*
+ * Make sure that the block doesn't try to pop below the stack level
+ * of an enclosing catch.
+ */
+ if (blockPtr->enclosingCatch != 0
+ && initialStackDepth + blockPtr->minStackDepth
+ < (blockPtr->enclosingCatch->initialStackDepth
+ + blockPtr->enclosingCatch->finalStackDepth)) {
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("code pops stack below level of"
+ " enclosing catch", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACKINCATCH", -1);
+ AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
+ Tcl_SetErrorLine(interp, blockPtr->startLine);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * Update maximum stgack depth.
+ */
maxDepth = initialStackDepth + blockPtr->maxStackDepth;
if (maxDepth > assemEnvPtr->maxDepth) {
assemEnvPtr->maxDepth = maxDepth;
@@ -3354,7 +3558,8 @@ ProcessCatchesInBasicBlock(AssemblyEnv* assemEnvPtr,
} else if (bbPtr->enclosingCatch != enclosing) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp,
- Tcl_NewStringObj("execution reaches block in "
+ Tcl_NewStringObj("execution reaches an "
+ "instruction in "
"inconsistent exception contexts",
-1));
Tcl_SetErrorLine(interp, bbPtr->startLine);
@@ -3390,31 +3595,6 @@ ProcessCatchesInBasicBlock(AssemblyEnv* assemEnvPtr,
/* TODO: Make sure that the test cases include validating
* that a natural loop can't include 'beginCatch' or 'endCatch' */
- if (bbPtr->flags & BB_DONECATCH) {
- /*
- * If the block finishes a catch body, the block and its successors
- * are outside the exception range. (The block may also end the
- * catch or begin another one, so we need to check for those
- * conditions as well.)
- */
- if (enclosing == NULL) {
- if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- Tcl_SetObjResult(interp,
- Tcl_NewStringObj("doneCatch without a "
- "corresponding beginCatch",
- -1));
- Tcl_SetErrorLine(interp, bbPtr->startLine);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADENDCATCH", NULL);
- }
- return TCL_ERROR;
- }
- if (bbPtr->catchState < BB_DONECATCH) {
- bbPtr->catchState = BBCS_DONECATCH;
- fallThruState = BBCS_DONECATCH;
- jumpState = BBCS_DONECATCH;
- }
- }
-
if (bbPtr->flags & BB_BEGINCATCH) {
/*
* If the block begins a catch, the state for the successor is
@@ -3514,10 +3694,11 @@ CheckForUnclosedCatches(AssemblyEnv* assemEnvPtr)
if (assemEnvPtr->curr_bb->catchState >= BBCS_INCATCH) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("catch still active on "
- "exit from block", -1));
+ "exit from assembly "
+ "code", -1));
Tcl_SetErrorLine(interp,
assemEnvPtr->curr_bb->enclosingCatch->startLine);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "UNCLOSEDCATCH", -1);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "UNCLOSEDCATCH", NULL);
}
return TCL_ERROR;
}
@@ -3585,12 +3766,6 @@ BuildExceptionRanges(AssemblyEnv* assemEnvPtr)
for (bbPtr = assemEnvPtr->head_bb; bbPtr != NULL; bbPtr=bbPtr->successor1) {
- /*fprintf(stderr, "block %p line %d byte %#x enclosing %p state %d"
- " depth %d\n",
- bbPtr, bbPtr->startLine, bbPtr->startOffset,
- bbPtr->enclosingCatch, bbPtr->catchState, bbPtr->catchDepth);
- fflush(stderr); */
-
UnstackExpiredCatches(envPtr, bbPtr, catchDepth,
catches, catchIndices);
LookForFreshCatches(bbPtr, catches);
@@ -3602,10 +3777,6 @@ BuildExceptionRanges(AssemblyEnv* assemEnvPtr)
catchDepth = bbPtr->catchDepth;
if (prevPtr != NULL
&& (prevPtr->flags & BB_BEGINCATCH)) {
- /*fprintf(stderr, "beginCatch at %d (depth=%d) "
- "is exception range %d\n",
- bbPtr->startOffset, catchDepth-1,
- catchIndices[catchDepth-1]); fflush(stderr); */
TclStoreInt4AtPtr(catchIndices[catchDepth-1],
envPtr->codeStart + bbPtr->startOffset - 4);
}
@@ -3662,8 +3833,6 @@ UnstackExpiredCatches(CompileEnv* envPtr,
while (catchDepth > bbPtr->catchDepth) {
--catchDepth;
- /* fprintf(stderr, "unstack exception range %d\n",
- catchIndices[catchDepth]); fflush(stderr); */
range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
catches[catchDepth] = NULL;
@@ -3682,9 +3851,7 @@ UnstackExpiredCatches(CompileEnv* envPtr,
--catchDepth;
if (catches[catchDepth] != NULL) {
if (catches[catchDepth] != catch
- || catchState >= BBCS_DONECATCH) {
- /* fprintf(stderr, "unstack changed exception range %d\n",
- catchIndices[catchDepth]); fflush(stderr); */
+ || catchState >= BBCS_CAUGHT) {
range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
catches[catchDepth] = NULL;
@@ -3729,13 +3896,8 @@ LookForFreshCatches(BasicBlock* bbPtr,
catchDepth = bbPtr->catchDepth;
while (catchDepth > 0) {
--catchDepth;
- if (catches[catchDepth] != catch && catchState < BBCS_DONECATCH) {
- /* fprintf(stderr, "new exception range needed for %s.\n",
- Tcl_GetString(catch->jumpTarget)); */
+ if (catches[catchDepth] != catch && catchState < BBCS_CAUGHT) {
catches[catchDepth] = catch;
- /* } else {
- fprintf(stderr, "new exception range not needed for %s\n",
- Tcl_GetString(catch->jumpTarget));*/
}
catchState = catch->catchState;
catch = catch->enclosingCatch;
@@ -3788,9 +3950,6 @@ StackFreshCatches(AssemblyEnv* assemEnvPtr,
catch = catches[catchDepth];
catchIndices[catchDepth] =
TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
- /* fprintf(stderr, "stack exception range %d at depth %d for %s\n",
- catchIndices[catchDepth], catchDepth,
- Tcl_GetString(catch->jumpTarget)); fflush(stderr); */
range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
range->nestingLevel = envPtr->exceptDepth + catchDepth;
envPtr->maxExceptDepth =
@@ -3845,23 +4004,14 @@ RestoreEmbeddedExceptionRanges(AssemblyEnv* assemEnvPtr)
bbPtr != NULL;
bbPtr = bbPtr->successor1) {
if (bbPtr->foreignExceptionCount != 0) {
- /* fprintf(stderr, "basic block %p has %d foreign exception ranges"
- " starting at %d\n",
- bbPtr, bbPtr->foreignExceptionCount,
- bbPtr->foreignExceptionBase); fflush(stderr); */
-
/*
* Reinstall the embedded exceptions and track their
* nesting level
*/
rangeBase = envPtr->exceptArrayNext;
- /* fprintf(stderr, "next exception at %d\n", rangeBase); */
for (i = 0; i < bbPtr->foreignExceptionCount; ++i) {
range = bbPtr->foreignExceptions + i;
rangeIndex = TclCreateExceptRange(range->type, envPtr);
- /* fprintf(stderr, "restore range %d -> %d\n",
- i + bbPtr->foreignExceptionBase,
- rangeIndex); fflush(stderr); */
range->nestingLevel += envPtr->exceptDepth + bbPtr->catchDepth;
memcpy(envPtr->exceptArrayPtr + rangeIndex, range,
sizeof(ExceptionRange));
@@ -3879,16 +4029,11 @@ RestoreEmbeddedExceptionRanges(AssemblyEnv* assemEnvPtr)
opcode = envPtr->codeStart[i];
if (opcode == INST_BEGIN_CATCH4) {
catchIndex = TclGetUInt4AtPtr(envPtr->codeStart + i + 1);
- /* fprintf(stderr, "pc %d exception %d\n",
- i, catchIndex); fflush(stderr); */
if (catchIndex >= bbPtr->foreignExceptionBase
&& catchIndex < (bbPtr->foreignExceptionBase +
bbPtr->foreignExceptionCount)) {
catchIndex -= bbPtr->foreignExceptionBase;
catchIndex += rangeBase;
- /* fprintf(stderr,
- "alter catch at %d to refer to range %d\n",
- i, catchIndex); fflush(stderr); */
TclStoreInt4AtPtr(catchIndex,
envPtr->codeStart + i + 1);
}
diff --git a/tests/assemble.test b/tests/assemble.test
index 7a05137..b9178ec 100644
--- a/tests/assemble.test
+++ b/tests/assemble.test
@@ -8,7 +8,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: assemble.test,v 1.1.2.15 2010/10/28 19:40:13 kennykb Exp $
+# RCS: @(#) $Id: assemble.test,v 1.1.2.16 2010/12/16 01:40:42 kennykb Exp $
#-----------------------------------------------------------------------------
# Commands covered: assemble
@@ -3111,6 +3111,81 @@ test assemble-30.3 {embedded catches} {
-cleanup {rename x {}}
}
+test assemble-30.4 {throw in wrong context} {
+ -body {
+ proc x {} {
+ list [catch {
+ assemble {
+ beginCatch @bad
+ push error
+ eval { list [catch {error whatever} result] $result }
+ invokeStk 2
+ push 0
+ reverse 2
+ jump @done
+
+ label @bad
+ load x
+ pushResult
+
+ label @done
+ endCatch
+ list 2
+ }
+ } result] $result $::errorCode [split $::errorInfo \n]
+ }
+ x
+ }
+ -match glob
+ -result {1 {"loadScalar1" instruction may not appear in a context where an exception has been caught and not disposed of.} {TCL ASSEM BADTHROW} {{"loadScalar1" instruction may not appear in a context where an exception has been caught and not disposed of.} { in assembly code between lines 10 and 15}*}}
+ -cleanup {rename x {}}
+}
+
+test assemble-30.5 {unclosed catch} {
+ -body {
+ proc x {} {
+ assemble {
+ beginCatch @error
+ push 0
+ jump @done
+ label @error
+ push 1
+ label @done
+ push ""
+ pop
+ }
+ }
+ list [catch {x} result] $result $::errorCode $::errorInfo
+ }
+ -match glob
+ -result {1 {catch still active on exit from assembly code} {TCL ASSEM UNCLOSEDCATCH} {catch still active on exit from assembly code
+ ("assemble" body, line 2)*}}
+ -cleanup {rename x {}}
+}
+
+test assemble-30.6 {inconsistent catch contexts} {
+ -body {
+ proc x {y} {
+ assemble {
+ load y
+ jumpTrue @inblock
+ beginCatch @error
+ label @inblock
+ push 0
+ jump @done
+ label @error
+ push 1
+ label @done
+ }
+ }
+ list [catch {x 2} result] $::errorCode $::errorInfo
+ }
+ -match glob
+ -result {1 {TCL ASSEM BADCATCH} {execution reaches an instruction in inconsistent exception contexts
+ ("assemble" body, line 5)*}}
+ -cleanup {rename x {}}
+}
+
# assemble-31 - Jump tables
test assemble-31.1 {jumpTable, wrong # args} {