* generic/tclBasic.c: NR-enabling [catch]

	* generic/tclCmdAH.c:
	* generic/tclInt.h:
	* tests/NRE.test:

5 files changed, 57 insertions, 7 deletions

diff --git a/ChangeLog b/ChangeLog
index 506acf3..87d8e5a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,10 @@
 2008-07-31  Miguel Sofer  <msofer@users.sf.net>
 
+	* generic/tclBasic.c:   NR-enabling [catch]
+	* generic/tclCmdAH.c:
+	* generic/tclInt.h:
+	* tests/NRE.test:
+	
 	* generic/tclBasic.c:     Moved the few remaining defs from
 	* generic/tclDictObj.c:   tclNRE.h to tclInt.h, eliminated
 	* generic/tclExecute.c:   inclusion of tclNRE.h everywhere.
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 8ffdcef..754d464 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -16,7 +16,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.342 2008/07/31 14:43:43 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.343 2008/07/31 15:42:06 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -184,7 +184,7 @@ static const CmdInfo builtInCmds[] = {
 #ifndef EXCLUDE_OBSOLETE_COMMANDS
     {"case",		Tcl_CaseObjCmd,		NULL,			NULL,	1},
 #endif
-    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	NULL,	1},
+    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	1},
     {"concat",		Tcl_ConcatObjCmd,	NULL,			NULL,	1},
     {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	1},
     {"error",		Tcl_ErrorObjCmd,	NULL,			NULL,	1},
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 6f4778b..409d633 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.99 2008/07/21 22:50:34 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.100 2008/07/31 15:42:06 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -30,6 +30,9 @@ static int		GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr,
 static char *		GetTypeFromMode(int mode);
 static int		StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName,
 			    Tcl_StatBuf *statPtr);
+static Tcl_NRPostProc	CatchObjCmdCallback;
+
+
 
 /*
  *----------------------------------------------------------------------
@@ -228,9 +231,18 @@ Tcl_CatchObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
+    return Tcl_NRCallObjProc(interp, TclNRCatchObjCmd, dummy, objc, objv);
+}
+
+int
+TclNRCatchObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
     Tcl_Obj *varNamePtr = NULL;
     Tcl_Obj *optionVarNamePtr = NULL;
-    int result;
     Interp *iPtr = (Interp *) interp;
 
     if ((objc < 2) || (objc > 4)) {
@@ -250,8 +262,23 @@ Tcl_CatchObjCmd(
      * TIP #280. Make invoking context available to caught script.
      */
 
-    result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
+    Tcl_NRAddCallback(interp, CatchObjCmdCallback, INT2PTR(objc),
+	    varNamePtr, optionVarNamePtr, NULL);
+	
+    return TclNREvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
+}
 
+static int
+CatchObjCmdCallback(
+    ClientData data[],
+    Tcl_Interp *interp,
+    int result)
+{
+    int objc = PTR2INT(data[0]);
+    Tcl_Obj *varNamePtr = data[1];
+    Tcl_Obj *optionVarNamePtr = data[2];
+    
+    
     /*
      * We disable catch in interpreters where the limit has been exceeded.
      */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index a098b5f..6941f18 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.382 2008/07/31 14:43:45 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.383 2008/07/31 15:42:07 msofer Exp $
  */
 
 #ifndef _TCLINT
@@ -2528,6 +2528,7 @@ MODULE_SCOPE char	tclEmptyString;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRNamespaceObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRApplyObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclNRCatchObjCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclTailcallObjCmd;
 
 MODULE_SCOPE int        TclNREvalCmd(Tcl_Interp * interp, Tcl_Obj * objPtr,
diff --git a/tests/NRE.test b/tests/NRE.test
index b80eed8..dfa6f59 100644
--- a/tests/NRE.test
+++ b/tests/NRE.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: NRE.test,v 1.8 2008/07/31 03:42:17 msofer Exp $
+# RCS: @(#) $Id: NRE.test,v 1.9 2008/07/31 15:42:08 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -285,6 +285,23 @@ test NRE-6.2 {[uplevel] is not recursive} -setup {
     rename a {}
 } -result {0 20001}
 
+test NRE-7.1 {[catch] is not recursive} -setup {
+    proc a i {
+	variable x [depthDiff]
+	if {[incr i] > 10} {
+	    return
+	}
+	uplevel 1 [list catch "a $i"]
+    }
+} -body {
+    catch {a 0}
+    lrange $x 0 3
+} -cleanup {
+    rename a {}
+    unset x
+} -result {0 3 3 0}
+
+
 #
 #  Basic TclOO tests
 #