diff options
author | Miguel Sofer <miguel.sofer@gmail.com> | 2008-07-31 15:42:06 (GMT) |
---|---|---|
committer | Miguel Sofer <miguel.sofer@gmail.com> | 2008-07-31 15:42:06 (GMT) |
commit | cad03f83809878b3802167f7b8cd219012690cc8 (patch) | |
tree | c1cd6fe19b292b68cd8a7fb589a5d7753ab2367f /generic/tclCmdAH.c | |
parent | 0a80549aa57439939e05b98b8471c00b2af09b49 (diff) | |
download | tcl-cad03f83809878b3802167f7b8cd219012690cc8.zip tcl-cad03f83809878b3802167f7b8cd219012690cc8.tar.gz tcl-cad03f83809878b3802167f7b8cd219012690cc8.tar.bz2 |
* generic/tclBasic.c: NR-enabling [catch]
* generic/tclCmdAH.c:
* generic/tclInt.h:
* tests/NRE.test:
Diffstat (limited to 'generic/tclCmdAH.c')
-rw-r--r-- | generic/tclCmdAH.c | 33 |
1 files changed, 30 insertions, 3 deletions
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. */ |