diff options
author | dgp <dgp@noemail.net> | 2009-08-12 16:06:35 (GMT) |
---|---|---|
committer | dgp <dgp@noemail.net> | 2009-08-12 16:06:35 (GMT) |
commit | e6eba5011fccd6ff44797f23165e12868376dd80 (patch) | |
tree | 304bf5c58de4d0e47cff5c024e4f94cfe16357bc /generic/tclCmdAH.c | |
parent | aa8022d8f4995279d49707cd5a2055d6c4a25911 (diff) | |
download | tcl-e6eba5011fccd6ff44797f23165e12868376dd80.zip tcl-e6eba5011fccd6ff44797f23165e12868376dd80.tar.gz tcl-e6eba5011fccd6ff44797f23165e12868376dd80.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:
FossilOrigin-Name: c2ac0ecc04f7f26d7397bd90f21b36cf3de6795a
Diffstat (limited to 'generic/tclCmdAH.c')
-rw-r--r-- | generic/tclCmdAH.c | 43 |
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; } |