summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2002-03-27 14:35:40 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2002-03-27 14:35:40 (GMT)
commite64c93e702240e727b329082367fb89cbe994591 (patch)
treefb25550d63d8991150f460cf93bd1a4df7b4e854
parent5003cf213ea8c44687443350d6c1c10d691dad4e (diff)
downloadtcl-e64c93e702240e727b329082367fb89cbe994591.zip
tcl-e64c93e702240e727b329082367fb89cbe994591.tar.gz
tcl-e64c93e702240e727b329082367fb89cbe994591.tar.bz2
avoid exceptional returns at level 0 [Bug 219181]
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclBasic.c12
-rw-r--r--tests/basic.test16
3 files changed, 32 insertions, 2 deletions
diff --git a/ChangeLog b/ChangeLog
index 7db9341..cddbbf7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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}