* generic/tclBasic.c (Tcl_EvalEx,TclEvalTokensStandard):

        * generic/tclCmdMZ.c (Tcl_SubstObj):
        * tests/basic.test (basic-46.4):        Restored recursion limit
        * tests/parse.test (parse-19.*):        testing in nested command
        substitutions within direct 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, 90 insertions, 24 deletions

diff --git a/ChangeLog b/ChangeLog
index 4f1666a..9d78dba 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,8 +1,17 @@
 2005-03-17  Don Porter  <dgp@users.sourceforge.net>
 
-	* generic/tclCompCmds.c (TclCompileIncrCmd):	Corrected checks
-	for immediate operand usage to permit leading space and sign
-	characters.  [Bug 1165671]
+        * generic/tclCompCmds.c (TclCompileIncrCmd):    Corrected checks
+        for immediate operand usage to permit leading space and sign
+        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,TclEvalTokensStandard):
+	* generic/tclCmdMZ.c (Tcl_SubstObj):
+        * tests/basic.test (basic-46.4):	Restored recursion limit
+        * tests/parse.test (parse-19.*):	testing in nested command
+	substitutions within direct 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 f61fc6a..dfa24e8 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.75.2.13 2005/02/10 19:03:59 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.75.2.14 2005/03/18 16:33:41 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -3405,14 +3405,21 @@ Tcl_EvalTokensStandard(interp, tokenPtr, count)
 		p = buffer;
 		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--;
 		if (code != TCL_OK) {
 		    goto done;
 		}
 		valuePtr = Tcl_GetObjResult(interp);
 		break;
+	    }
 
 	    case TCL_TOKEN_VARIABLE:
 		if (tokenPtr->numComponents == 1) {
@@ -3683,16 +3690,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++) {
@@ -3749,6 +3746,16 @@ Tcl_EvalEx(interp, script, numBytes, flags)
      * to the command.
      */
 
+    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/tclCmdMZ.c b/generic/tclCmdMZ.c
index 0b71be6..ce28e54 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -14,12 +14,13 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.82.2.14 2005/03/10 20:22:42 dgp Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.82.2.15 2005/03/18 16:33:42 dgp Exp $
  */
 
 #include "tclInt.h"
 #include "tclPort.h"
 #include "tclRegexp.h"
+#include "tclCompile.h"
 
 /*
  * Structure used to hold information about variable traces:
@@ -2652,7 +2653,12 @@ Tcl_SubstObj(interp, objPtr, flags)
 		    Tcl_AppendToObj(resultObj, old, p-old);
 		}
 		iPtr->evalFlags = TCL_BRACKET_TERM;
-		code = Tcl_EvalEx(interp, p+1, -1, 0);
+		iPtr->numLevels++;
+		code = TclInterpReady(interp);
+		if (code == TCL_OK) {
+		    code = Tcl_EvalEx(interp, p+1, -1, 0);
+		}
+		iPtr->numLevels--;
 		switch (code) {
 		case TCL_ERROR:
 		    goto errorResult;
diff --git a/tests/basic.test b/tests/basic.test
index 2c8a6a7..0a995ba 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.25.2.6 2005/02/10 18:58:36 msofer Exp $
+# RCS: @(#) $Id: basic.test,v 1.25.2.7 2005/03/18 16:33:43 dgp Exp $
 #
 
 package require tcltest 2
@@ -652,9 +652,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 8007fc2..124ab0f 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.11.2.1 2003/03/27 13:49:22 dkf Exp $
+# RCS: @(#) $Id: parse.test,v 1.11.2.2 2005/03/18 16:33:43 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -744,6 +744,52 @@ test parse-17.1 {Correct return codes from errors during substitution} {
     catch {eval {w[continue]}}
 } 4
 
+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*}
+
 # cleanup
 catch {unset a}
 ::tcltest::cleanupTests