diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclBasic.c | 12 | ||||
| -rw-r--r-- | tests/basic.test | 16 |
3 files changed, 32 insertions, 2 deletions
@@ -1,3 +1,9 @@ +2002-03-28 Miguel Sofer <msofer@users.sourceforge.net> + + * generic/tclBasic.c (Tcl_EvalEx): + * tests/basic.test: avoid exceptional returns at level 0 + [Bug 219181] + 2002-03-27 Don Porter <dgp@users.sourceforge.net> * doc/tcltest.n ([mainThread]): diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 3f4c5d6..5a4424b 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.53 2002/03/25 16:35:14 msofer Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.54 2002/03/27 14:35:40 msofer Exp $ */ #include "tclInt.h" @@ -3585,6 +3585,16 @@ Tcl_EvalEx(interp, script, numBytes, flags) iPtr->numLevels--; } if (code != TCL_OK) { + if (iPtr->numLevels == 0) { + if (code == TCL_RETURN) { + code = TclUpdateReturnInfo(iPtr); + } + if ((code != TCL_OK) && (code != TCL_ERROR) + && ((iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS) == 0)) { + ProcessUnexpectedResult(interp, code); + code = TCL_ERROR; + } + } goto error; } for (i = 0; i < objectsUsed; i++) { diff --git a/tests/basic.test b/tests/basic.test index 4aee121..a459e07 100644 --- a/tests/basic.test +++ b/tests/basic.test @@ -15,7 +15,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: basic.test,v 1.16 2002/03/23 01:39:57 msofer Exp $ +# RCS: @(#) $Id: basic.test,v 1.17 2002/03/27 14:35:40 msofer Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -583,6 +583,20 @@ test basic-46.1 {Tcl_AllowExceptions: exception return not allowed} { DONE }} +test basic-46.2 {Tcl_AllowExceptions: exception return not allowed} { + makeFile { + puts hello + break + } BREAKtest + set res [list [catch {exec [info nameofexecutable] BREAKtest} msg] $msg] + removeFile BREAKtest + set res +} {1 {hello +invoked "break" outside of a loop + while executing +"break" + (file "BREAKtest" line 3)}} + # cleanup catch {eval namespace delete [namespace children :: test_ns_*]} catch {namespace delete george} |