* Corrected problems with Tcl_AllowExceptions

        having influence over the wrong scope of Tcl_*Eval* calls.  Patch
        from Miguel Sofer.  Report from Jean-Claude Wippler.  [Bug 219181]

3 files changed, 42 insertions, 36 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index e8372ea..bb72114 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.55 2002/03/27 19:20:54 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.56 2002/03/29 21:01:11 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -3092,6 +3092,7 @@ Tcl_EvalObjv(interp, objc, objv, flags)
 				 * 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 @@ Tcl_EvalObjv(interp, objc, objv, flags)
 		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 @@ Tcl_EvalEx(interp, script, numBytes, flags)
     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 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 			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 @@ Tcl_EvalObjEx(interp, objPtr, flags)
     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 @@ Tcl_EvalObjEx(interp, objPtr, flags)
 	    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 @@ Tcl_EvalObjEx(interp, objPtr, flags)
 		result = TclUpdateReturnInfo(iPtr);
 	    }
 	    if ((result != TCL_OK) && (result != TCL_ERROR) 
-	        && ((iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS) == 0)) {
+	        && !allowExceptions) {
 		ProcessUnexpectedResult(interp, result);
 		result = TCL_ERROR;
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index e0bf175..074cb91 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.h,v 1.25 2002/02/15 14:28:48 dkf Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.26 2002/03/29 21:01:11 dgp Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -748,7 +748,7 @@ EXTERN int              TclInterpReady _ANSI_ARGS_((Tcl_Interp *interp));
  */
 
 EXTERN int		TclCompEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
-			    Tcl_Obj *objPtr, int engineCall));
+			    Tcl_Obj *objPtr));
 
 /*
  *----------------------------------------------------------------
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 92e345f..d737299 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.50 2002/03/22 22:54:35 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.51 2002/03/29 21:01:12 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -818,16 +818,11 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
  */
 
 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 @@ TclCompEvalObj(interp, objPtr, engineCall)
 	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 @@ TclCompEvalObj(interp, objPtr, engineCall)
      * Resetting the flags must be done after any compilation.
      */
 
-    evalFlags = iPtr->evalFlags;
     iPtr->evalFlags = 0;
 
     /*
@@ -926,7 +920,6 @@ TclCompEvalObj(interp, objPtr, engineCall)
      */
 
     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 @@ TclCompEvalObj(interp, objPtr, engineCall)
 	 */
 	
 	codePtr->refCount++;
+	iPtr->numLevels++;
 	result = TclExecuteByteCode(interp, codePtr);
+	iPtr->numLevels--;
 	codePtr->refCount--;
 	if (codePtr->refCount <= 0) {
 	    TclCleanupByteCode(codePtr);
@@ -952,16 +947,17 @@ TclCompEvalObj(interp, objPtr, engineCall)
 
     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 @@ TclCompEvalObj(interp, objPtr, engineCall)
 
     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 @@ TclExecuteByteCode(interp, codePtr)
 	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) {
 		/*