summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2008-07-18 13:10:47 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2008-07-18 13:10:47 (GMT)
commit5702c0a692ca453f9f0cbbbe3d438870ab8b008e (patch)
tree7f138a8e58380da9d3e0ecdf29eaead4e745fdd3
parentef5a491fc9ec989eef98fe3415dd79a6c12baf4f (diff)
downloadtcl-5702c0a692ca453f9f0cbbbe3d438870ab8b008e.zip
tcl-5702c0a692ca453f9f0cbbbe3d438870ab8b008e.tar.gz
tcl-5702c0a692ca453f9f0cbbbe3d438870ab8b008e.tar.bz2
NRE-enable oo::object.eval
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclOOBasic.c41
2 files changed, 33 insertions, 13 deletions
diff --git a/ChangeLog b/ChangeLog
index e2803c9..6214b1f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2008-07-18 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclOOBasic.c (TclOO_Object_Eval, FinalizeEval): NRE-enable
+ the oo::object.eval method.
+
2008-07-18 Miguel Sofer <msofer@users.sf.net>
* generic/tclDictObj.c (DictWithCmd, DictUpdateCmd): fix
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index 2b8535d..350dba6 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.3 2008/07/17 23:48:54 dkf Exp $
+ * RCS: @(#) $Id: tclOOBasic.c,v 1.4 2008/07/18 13:10:55 dkf Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -18,6 +18,8 @@
#include "tclInt.h"
#include "tclOOInt.h"
+static int FinalizeEval(ClientData data[],
+ Tcl_Interp *interp, int result);
static int RestoreFrame(ClientData data[],
Tcl_Interp *interp, int result);
@@ -263,6 +265,7 @@ TclOO_Object_Eval(
CallFrame *framePtr, **framePtrPtr = &framePtr;
Tcl_Obj *scriptPtr;
int result, flags;
+ CmdFrame *invoker;
if (objc-1 < skip) {
Tcl_WrongNumArgs(interp, skip, objv, "arg ?arg ...?");
@@ -298,30 +301,42 @@ 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;
}
/*
- * Evaluate the script now.
- * TODO: make NRE-aware
+ * Evaluate the script now, with FinalizeEval to do the processing after
+ * the script completes.
*/
- result = Tcl_EvalObjEx(interp, scriptPtr, flags);
+ TclNR_AddCallback(interp, FinalizeEval, object, NULL, NULL, NULL);
+ return TclNREvalObjEx(interp, scriptPtr, flags, invoker, skip);
+}
+
+static int
+FinalizeEval(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
if (result == TCL_ERROR) {
- Tcl_Obj *objnameObj;
+ Object *oPtr = data[0];
+
+ if (oPtr) {
+ Tcl_Obj *objnameObj = TclOOObjectName(interp, oPtr);
- if (object) {
- objnameObj = TclOOObjectName(interp, (Object *) object);
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (in \"%s eval\" script line %d)",
+ TclGetString(objnameObj), interp->errorLine));
} else {
- objnameObj = Tcl_NewStringObj("my", 2);
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (in \"my eval\" script line %d)",
+ interp->errorLine));
}
- Tcl_IncrRefCount(objnameObj);
- Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (in \"%s eval\" script line %d)",
- TclGetString(objnameObj), interp->errorLine));
- Tcl_DecrRefCount(objnameObj);
}
/*