diff options
-rw-r--r-- | generic/tclCompile.c | 6 | ||||
-rw-r--r-- | tests/compile.test | 11 |
2 files changed, 14 insertions, 3 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 408ec89..3c67280 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -6,11 +6,12 @@ * sequence of instructions ("bytecodes"). * * Copyright (c) 1996-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 by Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.11 1998/09/14 18:39:58 stanton Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.12 1999/02/02 22:26:11 stanton Exp $ */ #include "tclInt.h" @@ -6321,9 +6322,10 @@ CompileExprWord(interp, string, lastChar, flags, envPtr) envPtr->excRangeArrayNext = startRangeNext; inlineCode = 0; } else { - TclEmitOpcode(INST_END_CATCH, envPtr); + TclEmitOpcode(INST_END_CATCH, envPtr); /* for ok case */ TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup); envPtr->excRangeArrayPtr[range].catchOffset = TclCurrCodeOffset(); + TclEmitOpcode(INST_END_CATCH, envPtr); /* for error case */ } } diff --git a/tests/compile.test b/tests/compile.test index 2c01585..14f8864 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: compile.test,v 1.4 1998/09/14 18:40:08 stanton Exp $ +# RCS: @(#) $Id: compile.test,v 1.5 1999/02/02 22:26:12 stanton Exp $ if {[string compare test [info procs test]] == 1} then {source defs} @@ -170,6 +170,15 @@ test compile-6.1 {UpdateStringOfByteCode: called for duplicate of compiled empty p } {} +test compile-7.1 {BLACKBOX: exception stack overflow} { + set x {{0}} + set y 0 + while {$y < 100} { + if !$x {incr y} + } +} {} + + catch {rename p ""} catch {namespace delete test_ns_compile} catch {unset x} |