* generic/tclBasic.c (Tcl_EvalEx): Restored recursion limit

        * generic/tclParse.c (TclSubstTokens):  testing in nested command
        * tests/basic.test (basic-46.4):        substitutions within direct
        * tests/parse.test (parse-19.*):        script evaluation (Tcl_EvalEx)
        that got lost in the parser reforms of Tcl 8.1.  Added tests for
        correct behavior.  [Bug 1115904]

5 files changed, 80 insertions, 22 deletions

diff --git a/ChangeLog b/ChangeLog
index 2e0c663..2f7a55f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,7 +2,15 @@
 
         * generic/tclCompCmds.c (TclCompileIncrCmd):    Corrected checks
         for immediate operand usage to permit leading space and sign
-        characters.  [Bug 1165671]
+        characters.  Restores more efficient bytecode for [incr x -1]
+	that got lost in the CONST string reforms of Tcl 8.4.  [Bug 1165671]
+
+	* generic/tclBasic.c (Tcl_EvalEx):	Restored recursion limit
+	* generic/tclParse.c (TclSubstTokens):	testing in nested command
+	* tests/basic.test (basic-46.4):	substitutions within direct
+	* tests/parse.test (parse-19.*):	script evaluation (Tcl_EvalEx)
+	that got lost in the parser reforms of Tcl 8.1.  Added tests for
+	correct behavior.  [Bug 1115904]
 
 2005-03-15  Vince Darley  <vincentdarley@users.sourceforge.net>
 
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 086dfa9..1c497dc 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.141 2005/02/10 19:08:12 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.142 2005/03/18 15:50:59 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -3538,16 +3538,6 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 	            parse.commandStart, parse.commandSize, 0);
 	    iPtr->numLevels--;
 	    if (code != TCL_OK) {
-		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;
-		    }
-		}
 		goto error;
 	    }
 	    for (i = 0; i < objectsUsed; i++) {
@@ -3583,7 +3573,16 @@ Tcl_EvalEx(interp, script, numBytes, flags)
 
     error:
     /* Generate and log various pieces of error information. */
-
+	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) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { 
 	commandLength = parse.commandSize;
 	if (parse.term == parse.commandStart + commandLength - 1) {
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 09894bc..10eabdd 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.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: tclParse.c,v 1.39 2004/10/26 21:52:37 dgp Exp $
+ * RCS: @(#) $Id: tclParse.c,v 1.40 2005/03/18 15:51:00 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -2001,11 +2001,18 @@ TclSubstTokens(interp, tokenPtr, count, tokensLeftPtr)
 		break;
 	    }
 
-	    case TCL_TOKEN_COMMAND:
-		code = Tcl_EvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
-			0);
+	    case TCL_TOKEN_COMMAND: {
+		Interp *iPtr = (Interp *) interp;
+		iPtr->numLevels++;
+		code = TclInterpReady(interp);
+		if (code == TCL_OK) {
+		    code = Tcl_EvalEx(interp,
+			    tokenPtr->start+1, tokenPtr->size-2, 0);
+		}
+		iPtr->numLevels--;
 		appendObj = Tcl_GetObjResult(interp);
 		break;
+	    }
 
 	    case TCL_TOKEN_VARIABLE: {
 		Tcl_Obj *arrayIndex = NULL;
diff --git a/tests/basic.test b/tests/basic.test
index aaf6a65..005b458 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.38 2005/02/11 12:15:45 msofer Exp $
+# RCS: @(#) $Id: basic.test,v 1.39 2005/03/18 15:51:00 dgp Exp $
 #
 
 package require tcltest 2
@@ -604,9 +604,7 @@ test basic-46.4 {Tcl_AllowExceptions: exception return not allowed} -setup {
 } -cleanup {
     removeFile BREAKtest
 } -returnCodes error -match glob -result {invoked "break" outside of a loop
-    while executing
-"break"
-    invoked from within
+    while executing*
 "foo \[set a 1] \[break]"
     (file "*BREAKtest" line 2)}
 
diff --git a/tests/parse.test b/tests/parse.test
index 619cfdd..192e435 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -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: parse.test,v 1.19 2004/10/01 03:10:36 dgp Exp $
+# RCS: @(#) $Id: parse.test,v 1.20 2005/03/18 15:51:01 dgp Exp $
 
 if {[catch {package require tcltest 2.0.2}]} {
     puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
@@ -944,6 +944,52 @@ test parse-18.30 {Tcl_SubstObj, side effects} {
     set a
 } 1
 
+test parse-19.1 {Bug 1115904: recursion limit in Tcl_EvalEx} -constraints {
+    testevalex
+} -setup {
+    interp create i
+    load {} Tcltest i
+    i eval {proc {} args {}}
+    interp recursionlimit i 3
+} -body {
+    i eval {testevalex {[]}}
+} -cleanup {
+    interp delete i
+}
+
+test parse-19.2 {Bug 1115904: recursion limit in Tcl_EvalEx} -constraints {
+    testevalex
+} -setup {
+    interp create i
+    load {} Tcltest i
+    i eval {proc {} args {}}
+    interp recursionlimit i 3
+} -body {
+    i eval {testevalex {[[]]}}
+} -cleanup {
+    interp delete i
+} -returnCodes error -match glob -result {too many nested*}
+
+test parse-19.3 {Bug 1115904: recursion limit in Tcl_EvalEx} -setup {
+    interp create i
+    i eval {proc {} args {}}
+    interp recursionlimit i 3
+} -body {
+    i eval {subst {[]}}
+} -cleanup {
+    interp delete i
+}
+
+test parse-19.4 {Bug 1115904: recursion limit in Tcl_EvalEx} -setup {
+    interp create i
+    i eval {proc {} args {}}
+    interp recursionlimit i 3
+} -body {
+    i eval {subst {[[]]}}
+} -cleanup {
+    interp delete i
+} -returnCodes error -match glob -result {too many nested*}
+
     cleanupTests
 }