Index: doc/AllowExc.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/AllowExc.3,v
retrieving revision 1.2
diff -u -r1.2 AllowExc.3
--- doc/AllowExc.3	14 Sep 1998 18:39:45 -0000	1.2
+++ doc/AllowExc.3	29 Mar 2002 11:03:58 -0000
@@ -27,9 +27,19 @@
 .PP
 If a script is evaluated at top-level (i.e. no other scripts are
 pending evaluation when the script is invoked), and if the script
-terminates with a completion code other than TCL_OK, TCL_CONTINUE
+terminates with a completion code other than TCL_OK, TCL_ERROR
 or TCL_RETURN, then Tcl normally converts this into a TCL_ERROR
-return with an appropriate message.
+return with an appropriate message. A TCL_RETURN completion code is
+normally processed further, so that only TCL_OK and TCL_ERROR are
+valid top-level return codes.
+.PP
+This completion-code conversion at top-level is performed by the
+evaluation functions \fBTcl_EvalObjEx\fR, \fBTcl_EvalFile\fR,
+\fBTcl_EvalObjv\fR, \fBTcl_Eval\fR, \fBTcl_EvalEx\fR,
+\fBTcl_GlobalEval\fR, \fBTcl_GlobalEvalObj\fR, \fBTcl_VarEval\fR and
+\fBTcl_VarEvalVA\fR. The two token evaluation functions
+\fBTcl_EvalTokens\fR and \fBTcl_EvalTokensStandard\fR do \fBnot\fR
+check the execution level or convert their results.
 .PP
 However, if \fBTcl_AllowExceptions\fR is invoked immediately before
 calling a procedure such as \fBTcl_Eval\fR, then arbitrary completion
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.55
diff -u -r1.55 tclBasic.c
--- generic/tclBasic.c	27 Mar 2002 19:20:54 -0000	1.55
+++ generic/tclBasic.c	29 Mar 2002 11:04:15 -0000
@@ -3092,6 +3092,7 @@
 				 * string was generated. */
     int code = TCL_OK;
     int i;
+    int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
 
     for (tracePtr = iPtr->tracePtr; tracePtr; tracePtr = tracePtr->nextPtr) {
 	if (iPtr->numLevels <= tracePtr->level) {
@@ -3118,6 +3119,23 @@
 		flags);
 	iPtr->numLevels--;
     }
+
+    /*
+     * If we are again at the top level, process any unusual 
+     * return code returned by the evaluated code. 
+     */
+	
+    if (iPtr->numLevels == 0) {
+	if (code == TCL_RETURN) {
+	    code = TclUpdateReturnInfo(iPtr);
+	}
+	if ((code != TCL_OK) && (code != TCL_ERROR) 
+	    && !allowExceptions) {
+	    ProcessUnexpectedResult(interp, code);
+	    code = TCL_ERROR;
+	}
+    }
+	    
     if (code == TCL_ERROR) {
 
 	/* 
@@ -3488,6 +3506,7 @@
     int i, code, commandLength, bytesLeft, nested;
     CallFrame *savedVarFramePtr;   /* Saves old copy of iPtr->varFramePtr
 				    * in case TCL_EVAL_GLOBAL was set. */
+    int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
     
     /* For nested scripts, this variable will be set to point to the first 
      * char after the end of the script - needed only to compare pointers,
@@ -3591,7 +3610,7 @@
 			code = TclUpdateReturnInfo(iPtr);
 		    }
 		    if ((code != TCL_OK) && (code != TCL_ERROR) 
-			&& ((iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS) == 0)) {
+			&& !allowExceptions) {
 			ProcessUnexpectedResult(interp, code);
 			code = TCL_ERROR;
 		    }
@@ -3841,6 +3860,7 @@
     int result;
     CallFrame *savedVarFramePtr;	/* Saves old copy of iPtr->varFramePtr
 					 * in case TCL_EVAL_GLOBAL was set. */
+    int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
 
     Tcl_IncrRefCount(objPtr);
 
@@ -3880,7 +3900,7 @@
 	    iPtr->varFramePtr = NULL;
 	}
 
-	result = TclCompEvalObj(interp, objPtr, /* engineCall */ 0);
+	result = TclCompEvalObj(interp, objPtr);
 
 	/*
 	 * If we are again at the top level, process any unusual 
@@ -3892,7 +3912,7 @@
 		result = TclUpdateReturnInfo(iPtr);
 	    }
 	    if ((result != TCL_OK) && (result != TCL_ERROR) 
-	        && ((iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS) == 0)) {
+	        && !allowExceptions) {
 		ProcessUnexpectedResult(interp, result);
 		result = TCL_ERROR;
 
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.25
diff -u -r1.25 tclCompile.h
--- generic/tclCompile.h	15 Feb 2002 14:28:48 -0000	1.25
+++ generic/tclCompile.h	29 Mar 2002 11:04:25 -0000
@@ -748,7 +748,7 @@
  */
 
 EXTERN int		TclCompEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr, int engineCall));
+			    Tcl_Obj *objPtr));
 
 /*
  *----------------------------------------------------------------
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.50
diff -u -r1.50 tclExecute.c
--- generic/tclExecute.c	22 Mar 2002 22:54:35 -0000	1.50
+++ generic/tclExecute.c	29 Mar 2002 11:04:29 -0000
@@ -818,16 +818,11 @@
  */
 
 int
-TclCompEvalObj(interp, objPtr, engineCall)
+TclCompEvalObj(interp, objPtr)
     Tcl_Interp *interp;
     Tcl_Obj *objPtr;
-    int engineCall;                    /* Set to 1 if it is an internal 
-					* engine call, 0 if called from 
-					* Tcl_EvalObjEx */
 {
     register Interp *iPtr = (Interp *) interp;
-    int evalFlags;			/* Interp->evalFlags value when the
-					 * procedure was called. */
     register ByteCode* codePtr;		/* Tcl Internal type of bytecode. */
     int oldCount = iPtr->cmdCount;	/* Used to tell whether any commands
 					 * at all were executed. */
@@ -896,7 +891,7 @@
 	iPtr->errorLine = 1; 
 	result = tclByteCodeType.setFromAnyProc(interp, objPtr);
 	if (result != TCL_OK) {
-	    return result;;
+	    return result;
 	}
     } else {
 	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
@@ -917,7 +912,6 @@
      * Resetting the flags must be done after any compilation.
      */
 
-    evalFlags = iPtr->evalFlags;
     iPtr->evalFlags = 0;
 
     /*
@@ -926,7 +920,6 @@
      */
 
     numSrcBytes = codePtr->numSrcBytes;
-    iPtr->numLevels++;
     if ((numSrcBytes > 0) || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
 	/*
 	 * Increment the code's ref count while it is being executed. If
@@ -934,7 +927,9 @@
 	 */
 	
 	codePtr->refCount++;
+	iPtr->numLevels++;
 	result = TclExecuteByteCode(interp, codePtr);
+	iPtr->numLevels--;
 	codePtr->refCount--;
 	if (codePtr->refCount <= 0) {
 	    TclCleanupByteCode(codePtr);
@@ -952,16 +947,17 @@
 
     if ((oldCount == iPtr->cmdCount) && Tcl_AsyncReady()) {
 	result = Tcl_AsyncInvoke(interp, result);
-    }
-
-    /*
-     * If an error occurred, record information about what was being
-     * executed when the error occurred.
-     */
+    
 
-    if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
-	script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
-	Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
+	/*
+	 * If an error occurred, record information about what was being
+	 * executed when the error occurred.
+	 */
+	
+	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+	    Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
+	}
     }
 
     /*
@@ -973,16 +969,6 @@
 
     iPtr->termOffset = numSrcBytes;
     iPtr->flags &= ~ERR_ALREADY_LOGGED;
-    iPtr->numLevels--;
-
-    /* 
-     * Tcl_EvalObjEx needs the evalFlags for error reporting at
-     * iPtr->numLevels 0 - we pass it here, it will reset them.
-     */
-
-    if (!engineCall) {
-	iPtr->evalFlags = evalFlags;
-    }
 
     return result;
 }
@@ -1411,7 +1397,7 @@
 	case INST_EVAL_STK:
 	    objPtr = POP_OBJECT();
 	    DECACHE_STACK_INFO();
-	    result = TclCompEvalObj(interp, objPtr, /* engineCall */ 1);
+	    result = TclCompEvalObj(interp, objPtr);
 	    CACHE_STACK_INFO();
 	    if (result == TCL_OK) {
 		/*
Index: tests/basic.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/basic.test,v
retrieving revision 1.17
diff -u -r1.17 basic.test
--- tests/basic.test	27 Mar 2002 14:35:40 -0000	1.17
+++ tests/basic.test	29 Mar 2002 11:04:32 -0000
@@ -597,6 +597,47 @@
 "break"
     (file "BREAKtest" line 3)}}    
 
+test basic-46.3 {Tcl_AllowExceptions: exception return not allowed} {
+    makeFile {
+	interp alias {} patch {} info patchlevel
+	patch
+	break
+    } BREAKtest
+    set res [list [catch {exec [info nameofexecutable] BREAKtest} msg] $msg]
+    removeFile BREAKtest
+    set res
+} {1 {invoked "break" outside of a loop
+    while executing
+"break"
+    (file "BREAKtest" line 4)}}    
+
+test basic-46.4 {Tcl_AllowExceptions: exception return not allowed} {
+    makeFile {
+	foo [set a 1] [break]
+    } BREAKtest
+    set res [list [catch {exec [info nameofexecutable] BREAKtest} msg] $msg]
+    removeFile BREAKtest
+    set res
+} {1 {invoked "break" outside of a loop
+    while executing
+"break"
+    invoked from within
+"foo [set a 1] [break]"
+    (file "BREAKtest" line 2)}}
+
+test basic-46.5 {Tcl_AllowExceptions: exception return not allowed} {
+    makeFile {
+	return -code return
+    } BREAKtest
+    set res [list [catch {exec [info nameofexecutable] BREAKtest} msg] $msg]
+    removeFile BREAKtest
+    set res
+} {1 {command returned bad code: 2
+    while executing
+"return -code return"
+    (file "BREAKtest" line 2)}}
+
+
 # cleanup
 catch {eval namespace delete [namespace children :: test_ns_*]}
 catch {namespace delete george}
