summaryrefslogtreecommitdiffstats
path: root/generic/tclCmdAH.c
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2009-08-12 16:06:35 (GMT)
committerdgp <dgp@users.sourceforge.net>2009-08-12 16:06:35 (GMT)
commit0c4df9767cafc8b3a0d1c1e472b87610bfa7a84f (patch)
tree304bf5c58de4d0e47cff5c024e4f94cfe16357bc /generic/tclCmdAH.c
parentf92b24a616e3a96bef3765e9bda4b66f3c7e5010 (diff)
downloadtcl-0c4df9767cafc8b3a0d1c1e472b87610bfa7a84f.zip
tcl-0c4df9767cafc8b3a0d1c1e472b87610bfa7a84f.tar.gz
tcl-0c4df9767cafc8b3a0d1c1e472b87610bfa7a84f.tar.bz2
TIP #353 IMPLEMENTATION
* doc/NRE.3: New public routine Tcl_NRExprObj() permits * generic/tcl.decls: extension commands to evaluate Tcl expressions * generic/tclBasic.c: in NR-enabled command procedures. * generic/tclCmdAH.c: * generic/tclExecute.c: * generic/tclInt.h: * generic/tclObj.c: * tests/expr.test: * generic/tclDecls.h: make genstubs * generic/tclStubInit.c:
Diffstat (limited to 'generic/tclCmdAH.c')
-rw-r--r--generic/tclCmdAH.c43
1 files changed, 34 insertions, 9 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index b268bfc..85b098a 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.118 2009/07/24 20:45:22 dgp Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.119 2009/08/12 16:06:43 dgp Exp $
*/
#include "tclInt.h"
@@ -58,6 +58,7 @@ static const char * GetTypeFromMode(int mode);
static int StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName,
Tcl_StatBuf *statPtr);
static Tcl_NRPostProc CatchObjCmdCallback;
+static Tcl_NRPostProc ExprCallback;
static Tcl_NRPostProc ForNextCallback;
static Tcl_NRPostProc ForeachLoopStep;
static Tcl_NRPostProc EvalCmdErrMsg;
@@ -837,29 +838,53 @@ Tcl_ExprObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_Obj *resultPtr;
- int result;
+ return Tcl_NRCallObjProc(interp, TclNRExprObjCmd, dummy, objc, objv);
+}
+
+int
+TclNRExprObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_Obj *resultPtr, *objPtr;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
return TCL_ERROR;
}
+ TclNewObj(resultPtr);
+ Tcl_IncrRefCount(resultPtr);
if (objc == 2) {
- result = Tcl_ExprObj(interp, objv[1], &resultPtr);
+ objPtr = objv[1];
+ TclNRAddCallback(interp, ExprCallback, resultPtr, NULL, NULL, NULL);
} else {
- Tcl_Obj *objPtr = Tcl_ConcatObj(objc-1, objv+1);
+ objPtr = Tcl_ConcatObj(objc-1, objv+1);
+ TclNRAddCallback(interp, ExprCallback, resultPtr, objPtr, NULL, NULL);
+ }
+
+ return Tcl_NRExprObj(interp, objPtr, resultPtr);
+}
+
+static int
+ExprCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_Obj *resultPtr = data[0];
+ Tcl_Obj *objPtr = data[1];
- Tcl_IncrRefCount(objPtr);
- result = Tcl_ExprObj(interp, objPtr, &resultPtr);
+ if (objPtr != NULL) {
Tcl_DecrRefCount(objPtr);
}
if (result == TCL_OK) {
Tcl_SetObjResult(interp, resultPtr);
- Tcl_DecrRefCount(resultPtr); /* Done with the result object */
}
-
+ Tcl_DecrRefCount(resultPtr);
return result;
}