Attachment "219181.patch" to
ticket [219181ffff]
added by
msofer
2002-03-27 21:30:01.
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.53
diff -u -r1.53 tclBasic.c
--- generic/tclBasic.c 25 Mar 2002 16:35:14 -0000 1.53
+++ generic/tclBasic.c 27 Mar 2002 14:24:54 -0000
@@ -3585,6 +3585,16 @@
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++) {
Index: tests/basic.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/basic.test,v
retrieving revision 1.16
diff -u -r1.16 basic.test
--- tests/basic.test 23 Mar 2002 01:39:57 -0000 1.16
+++ tests/basic.test 27 Mar 2002 14:24:54 -0000
@@ -583,6 +583,20 @@
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}
