* generic/tclCmdAH.c: nre-enabling [eval]; eval scripts are now

	* generic/tclOOBasic.c:    bytecompiled. Adapted recursion limit tests
	* tests/interp.test:       that were relying on eval not being
	* tests/nre.test:          compiled. Part of the [Bug 2017632] project.
	* tests/unsupported.test:

6 files changed, 244 insertions, 47 deletions

diff --git a/ChangeLog b/ChangeLog
index 8f5fab5..0d462ed 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2008-09-01  Miguel Sofer  <msofer@users.sf.net>
+
+	* generic/tclCmdAH.c:      nre-enabling [eval]; eval scripts are now
+	* generic/tclOOBasic.c:    bytecompiled. Adapted recursion limit tests
+	* tests/interp.test:       that were relying on eval not being 
+	* tests/nre.test:          compiled. Part of the [Bug 2017632] project.
+	* tests/unsupported.test:
+
 2008-09-01  Donal K. Fellows  <dkf@users.sf.net>
 
 	* generic/tclOOMethod.c (InvokeProcedureMethod): 
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 272cb20..80aadeb 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdAH.c,v 1.103 2008/08/24 14:38:11 dkf Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.104 2008/09/01 12:28:08 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -57,6 +57,7 @@ static int		StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName,
 static Tcl_NRPostProc	CatchObjCmdCallback;
 static Tcl_NRPostProc	ForNextCallback;
 static Tcl_NRPostProc	ForeachLoopStep;
+static Tcl_NRPostProc   EvalCmdErrMsg;
 
 /*
  *----------------------------------------------------------------------
@@ -690,6 +691,21 @@ Tcl_ErrorObjCmd(
  */
 
 	/* ARGSUSED */
+
+static int
+EvalCmdErrMsg(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    if (result == TCL_ERROR) {
+	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+		"\n    (\"eval\" body line %d)", interp->errorLine));
+    }
+    return result;
+}
+
+
 int
 Tcl_EvalObjCmd(
     ClientData dummy,		/* Not used. */
@@ -697,9 +713,10 @@ Tcl_EvalObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    int result;
     register Tcl_Obj *objPtr;
     Interp *iPtr = (Interp *) interp;
+    CmdFrame* invoker = NULL;
+    int word          = 0;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
@@ -711,32 +728,24 @@ Tcl_EvalObjCmd(
 	 * TIP #280. Make argument location available to eval'd script.
 	 */
 
-	CmdFrame* invoker = iPtr->cmdFramePtr;
-	int word          = 1;
-	TclArgumentGet (interp, objv[1], &invoker, &word);
-
-	result = TclEvalObjEx(interp, objv[1], TCL_EVAL_DIRECT,
-		invoker, word);
+	invoker = iPtr->cmdFramePtr;
+	word    = 1;
+	objPtr = objv[1];
+	TclArgumentGet (interp, objPtr, &invoker, &word);
     } else {
 	/*
 	 * More than one argument: concatenate them together with spaces
 	 * between, then evaluate the result. Tcl_EvalObjEx will delete the
-	 * object when it decrements its refcount after eval'ing it.
+	 * object when it decrements its refcount after eval'ing it.	
+	 *
+	 * TIP #280. Make invoking context available to eval'd script, done
+	 * with the default values.
 	 */
 
 	objPtr = Tcl_ConcatObj(objc-1, objv+1);
-
-	/*
-	 * TIP #280. Make invoking context available to eval'd script.
-	 */
-
-	result = TclEvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, 0);
-    }
-    if (result == TCL_ERROR) {
-	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		"\n    (\"eval\" body line %d)", interp->errorLine));
     }
-    return result;
+    TclNRAddCallback(interp, EvalCmdErrMsg,NULL, NULL, NULL, NULL);
+    return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
 }
 
 /*
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index 28033cd..9df3907 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclOOBasic.c,v 1.9 2008/07/31 14:43:47 msofer Exp $
+ * RCS: @(#) $Id: tclOOBasic.c,v 1.10 2008/09/01 12:28:09 msofer Exp $
  */
 
 #ifdef HAVE_CONFIG_H
@@ -293,7 +293,7 @@ TclOO_Object_Eval(
     register const int skip = Tcl_ObjectContextSkippedArgs(context);
     CallFrame *framePtr, **framePtrPtr = &framePtr;
     Tcl_Obj *scriptPtr;
-    int result, flags;
+    int result;
     CmdFrame *invoker;
 
     if (objc-1 < skip) {
@@ -329,11 +329,9 @@ TclOO_Object_Eval(
 
     if (objc != skip+1) {
 	scriptPtr = Tcl_ConcatObj(objc-skip, objv+skip);
-	flags = TCL_EVAL_DIRECT;
 	invoker = NULL;
     } else {
 	scriptPtr = objv[skip];
-	flags = 0;
 	invoker = ((Interp *) interp)->cmdFramePtr;
     }
 
@@ -343,7 +341,7 @@ TclOO_Object_Eval(
      */
 
     TclNRAddCallback(interp, FinalizeEval, object, NULL, NULL, NULL);
-    return TclNREvalObjEx(interp, scriptPtr, flags, invoker, skip);
+    return TclNREvalObjEx(interp, scriptPtr, 0, invoker, skip);
 }
 
 static int
diff --git a/tests/interp.test b/tests/interp.test
index 33dfda9..01e3ca8 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: interp.test,v 1.60 2008/07/19 22:50:38 nijtmans Exp $
+# RCS: @(#) $Id: interp.test,v 1.61 2008/09/01 12:28:09 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -2623,7 +2623,12 @@ test interp-29.3.6 {recursion limit error reporting} {
     list $r1 $r2
 } {0 ok}
 
-test interp-29.3.7 {recursion limit error reporting} {
+#
+# Note that TEBC does not verify the interp's nesting level itself; the nesting
+# level will only be verified when it invokes a non-bcc'd command.
+#
+
+test interp-29.3.7a {recursion limit error reporting} {
     interp create slave
     after 0 {interp recursionlimit slave 5}
     set r1 [slave eval {
@@ -2632,8 +2637,53 @@ test interp-29.3.7 {recursion limit error reporting} {
 	        eval {		# 3
 		    eval {	# 4
 		        eval {	# 5
-			     update
-			     set x ok
+			    update
+			    set x ok
+			}
+		    }
+		}
+	    }
+	} msg
+    }]
+    set r2 [slave eval { set msg }]
+    interp delete slave
+    list $r1 $r2
+} {0 ok}
+
+test interp-29.3.7b {recursion limit error reporting} {
+    interp create slave
+    after 0 {interp recursionlimit slave 5}
+    set r1 [slave eval {
+        catch { 		# nesting level 1
+	    eval {		# 2
+	        eval {		# 3
+		    eval {	# 4
+			update
+		        eval {	# 5
+			    set x ok
+			}
+		    }
+		}
+	    }
+	} msg
+    }]
+    set r2 [slave eval { set msg }]
+    interp delete slave
+    list $r1 $r2
+} {0 ok}
+
+test interp-29.3.7c {recursion limit error reporting} {
+    interp create slave
+    after 0 {interp recursionlimit slave 5}
+    set r1 [slave eval {
+        catch { 		# nesting level 1
+	    eval {		# 2
+	        eval {		# 3
+		    eval {	# 4
+		        eval {	# 5
+			    update
+			    set set set
+			    $set x ok
 			}
 		    }
 		}
@@ -2645,7 +2695,7 @@ test interp-29.3.7 {recursion limit error reporting} {
     list $r1 $r2
 } {1 {too many nested evaluations (infinite loop?)}}
 
-test interp-29.3.8 {recursion limit error reporting} {
+test interp-29.3.8a {recursion limit error reporting} {
     interp create slave
     after 0 {interp recursionlimit slave 4}
     set r1 [slave eval {
@@ -2654,8 +2704,30 @@ test interp-29.3.8 {recursion limit error reporting} {
 	        eval {		# 3
 		    eval {	# 4
 		        eval {	# 5
-			     update
-			     set x ok
+			    update
+			    set x ok
+			}
+		    }
+		}
+	    }
+	} msg
+    }]
+    set r2 [slave eval { set msg }]
+    interp delete slave
+    list $r1 $r2
+} {0 ok}
+
+test interp-29.3.8b {recursion limit error reporting} {
+    interp create slave
+    after 0 {interp recursionlimit slave 4}
+    set r1 [slave eval {
+        catch { 		# nesting level 1
+	    eval {		# 2
+	        eval {		# 3
+		    eval {	# 4
+			update
+		        eval {	# 5
+			    set x ok
 			}
 		    }
 		}
@@ -2667,7 +2739,7 @@ test interp-29.3.8 {recursion limit error reporting} {
     list $r1 $r2
 } {1 {too many nested evaluations (infinite loop?)}}
 
-test interp-29.3.9 {recursion limit error reporting} {
+test interp-29.3.9a {recursion limit error reporting} {
     interp create slave
     after 0 {interp recursionlimit slave 6}
     set r1 [slave eval {
@@ -2676,8 +2748,30 @@ test interp-29.3.9 {recursion limit error reporting} {
 	        eval {		# 3
 		    eval {	# 4
 		        eval {	# 5
-			     update
-			     set x ok
+			    update
+			    set x ok
+			}
+		    }
+		}
+	    }
+	} msg
+    }]
+    set r2 [slave eval { set msg }]
+    interp delete slave
+    list $r1 $r2
+} {0 ok}
+
+test interp-29.3.9b {recursion limit error reporting} {
+    interp create slave
+    after 0 {interp recursionlimit slave 6}
+    set r1 [slave eval {
+        catch { 		# nesting level 1
+	    eval {		# 2
+	        eval {		# 3
+		    eval {	# 4
+		        eval {	# 5
+			    set set set
+			    $set x ok
 			}
 		    }
 		}
@@ -2689,7 +2783,7 @@ test interp-29.3.9 {recursion limit error reporting} {
     list $r1 $r2
 } {0 ok}
 
-test interp-29.3.10 {recursion limit error reporting} {
+test interp-29.3.10a {recursion limit error reporting} {
     interp create slave
     after 0 {slave recursionlimit 4}
     set r1 [slave eval {
@@ -2709,9 +2803,31 @@ test interp-29.3.10 {recursion limit error reporting} {
     set r2 [slave eval { set msg }]
     interp delete slave
     list $r1 $r2
+} {0 ok}
+
+test interp-29.3.10b {recursion limit error reporting} {
+    interp create slave
+    after 0 {slave recursionlimit 4}
+    set r1 [slave eval {
+        catch { 		# nesting level 1
+	    eval {		# 2
+	        eval {		# 3
+		    eval {	# 4
+			update
+		        eval {	# 5
+			    set x ok
+			}
+		    }
+		}
+	    }
+	} msg
+    }]
+    set r2 [slave eval { set msg }]
+    interp delete slave
+    list $r1 $r2
 } {1 {too many nested evaluations (infinite loop?)}}
 
-test interp-29.3.11 {recursion limit error reporting} {
+test interp-29.3.11a {recursion limit error reporting} {
     interp create slave
     after 0 {slave recursionlimit 5}
     set r1 [slave eval {
@@ -2720,8 +2836,31 @@ test interp-29.3.11 {recursion limit error reporting} {
 	        eval {		# 3
 		    eval {	# 4
 		        eval {	# 5
-			     update
-			     set x ok
+			    update
+			    set x ok
+			}
+		    }
+		}
+	    }
+	} msg
+    }]
+    set r2 [slave eval { set msg }]
+    interp delete slave
+    list $r1 $r2
+} {0 ok}
+
+test interp-29.3.11b {recursion limit error reporting} {
+    interp create slave
+    after 0 {slave recursionlimit 5}
+    set r1 [slave eval {
+        catch { 		# nesting level 1
+	    eval {		# 2
+	        eval {		# 3
+		    eval {	# 4
+		        eval {	# 5
+			    update
+			    set set set
+			    $set x ok
 			}
 		    }
 		}
@@ -2733,7 +2872,7 @@ test interp-29.3.11 {recursion limit error reporting} {
     list $r1 $r2
 } {1 {too many nested evaluations (infinite loop?)}}
 
-test interp-29.3.12 {recursion limit error reporting} {
+test interp-29.3.12a {recursion limit error reporting} {
     interp create slave
     after 0 {slave recursionlimit 6}
     set r1 [slave eval {
@@ -2742,8 +2881,31 @@ test interp-29.3.12 {recursion limit error reporting} {
 	        eval {		# 3
 		    eval {	# 4
 		        eval {	# 5
-			     update
-			     set x ok
+			    update
+			    set x ok
+			}
+		    }
+		}
+	    }
+	} msg
+    }]
+    set r2 [slave eval { set msg }]
+    interp delete slave
+    list $r1 $r2
+} {0 ok}
+
+test interp-29.3.12b {recursion limit error reporting} {
+    interp create slave
+    after 0 {slave recursionlimit 6}
+    set r1 [slave eval {
+        catch { 		# nesting level 1
+	    eval {		# 2
+	        eval {		# 3
+		    eval {	# 4
+		        eval {	# 5
+			    update
+			    set set set
+			    $set x ok
 			}
 		    }
 		}
diff --git a/tests/nre.test b/tests/nre.test
index cc15b13..c415150 100644
--- a/tests/nre.test
+++ b/tests/nre.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: nre.test,v 1.4 2008/08/22 18:27:27 dgp Exp $
+# RCS: @(#) $Id: nre.test,v 1.5 2008/09/01 12:28:10 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -236,6 +236,26 @@ test nre-7.5 {[foreach] is not recursive} -constraints {knownBug} -setup {
     unset abs
 } -result {{0 2 2 0} 0}
 
+test nre-7.6 {[eval] is not recursive} -setup {
+    proc a i [makebody {eval [list a $i]}]
+} -body {
+    setabs
+    a 0
+} -cleanup {
+    rename a {}
+    unset abs
+} -result {{0 2 2 1} 0}
+
+test nre-7.7 {[eval] is not recursive} -setup {
+    proc a i [makebody {eval "a $i"}]
+} -body {
+    setabs
+    a 0
+} -cleanup {
+    rename a {}
+    unset abs
+} -result {{0 2 2 1} 0}
+
 test nre-8.1 {nre and {*}} -body {
     # force an expansion that grows the evaluation stack, check that nre
     # adapts the bottomPtr. This crashes on failure.
diff --git a/tests/unsupported.test b/tests/unsupported.test
index 0267c58..37a9313 100644
--- a/tests/unsupported.test
+++ b/tests/unsupported.test
@@ -9,7 +9,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: unsupported.test,v 1.7 2008/08/26 22:37:05 msofer Exp $
+# RCS: @(#) $Id: unsupported.test,v 1.8 2008/09/01 12:28:10 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -618,7 +618,7 @@ test unsupported-C.1.9 {yield in nested eval} -constraints {coroutine} \
 } -cleanup {
     rename moo {}
     unset body res
-} -returnCodes error -result {cannot yield: C stack busy}
+} -result {0 10 20}
 
 test unsupported-C.1.10 {yield in nested eval} -constraints {coroutine} \
 -setup {
@@ -629,7 +629,7 @@ test unsupported-C.1.10 {yield in nested eval} -constraints {coroutine} \
 	yield
 	
 	while {$i < $imax} {
-	    eval yield
+	    eval yield [expr {$i*$stop}]
 	    incr i
 	}
     }
@@ -642,7 +642,7 @@ test unsupported-C.1.10 {yield in nested eval} -constraints {coroutine} \
     set res
 } -cleanup {
     unset body res
-} -returnCodes error -result {cannot yield: C stack busy}
+} -result {0 10 20}
 
 test unsupported-C.1.11 {yield outside coroutine} -constraints {coroutine} \
 -setup {