avoid exceptional returns at level 0 [Bug 219181]

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}