summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2009-04-11 11:18:51 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2009-04-11 11:18:51 (GMT)
commit82bda7f2081c47a741b7e6217cf061137fd35219 (patch)
tree7384ba8f128f12704a52e5fc85f4c8074f6fb83e /generic
parente77f7f0935b2ac4f3f02ec972fc4d14366f880c3 (diff)
downloadtcl-82bda7f2081c47a741b7e6217cf061137fd35219.zip
tcl-82bda7f2081c47a741b7e6217cf061137fd35219.tar.gz
tcl-82bda7f2081c47a741b7e6217cf061137fd35219.tar.bz2
Clarify the rules for resolution of what forwarded methods forward to.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclOOInt.h16
-rw-r--r--generic/tclOOMethod.c18
2 files changed, 27 insertions, 7 deletions
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index 3221fcc..1579ddb 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -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: tclOOInt.h,v 1.10 2008/10/31 22:08:32 dkf Exp $
+ * RCS: @(#) $Id: tclOOInt.h,v 1.11 2009/04/11 11:18:51 dkf Exp $
*/
#ifndef TCL_OO_INTERNAL_H
@@ -117,13 +117,19 @@ typedef struct ProcedureMethod {
#define USE_DECLARER_NS 0x80
/*
- * Forwarded methods have the following extra information. It is a
- * single-field structure because this allows for future expansion without
- * changing vast amounts of code.
+ * Forwarded methods have the following extra information.
*/
typedef struct ForwardMethod {
- Tcl_Obj *prefixObj;
+ Tcl_Obj *prefixObj; /* The list of values to use to replace the
+ * object and method name with. Will be a
+ * non-empty list. */
+ int fullyQualified; /* If 1, the command name is fully qualified
+ * and we should let the default Tcl mechanism
+ * handle the command lookup because it is
+ * more efficient. If 0, we need to do a
+ * specialized lookup based on the current
+ * object's namespace. */
} ForwardMethod;
/*
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 2606f0a..3422660 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -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: tclOOMethod.c,v 1.21 2008/12/02 19:40:41 dgp Exp $
+ * RCS: @(#) $Id: tclOOMethod.c,v 1.22 2009/04/11 11:18:51 dkf Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -1316,6 +1316,7 @@ TclOONewForwardInstanceMethod(
{
int prefixLen;
register ForwardMethod *fmPtr;
+ Tcl_Obj *cmdObj;
if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
return NULL;
@@ -1328,6 +1329,8 @@ TclOONewForwardInstanceMethod(
fmPtr = (ForwardMethod *) ckalloc(sizeof(ForwardMethod));
fmPtr->prefixObj = prefixObj;
+ Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);
+ fmPtr->fullyQualified = (strncmp(TclGetString(cmdObj), "::", 2) == 0);
Tcl_IncrRefCount(prefixObj);
return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr,
nameObj, flags, &fwdMethodType, fmPtr);
@@ -1354,6 +1357,7 @@ TclOONewForwardMethod(
{
int prefixLen;
register ForwardMethod *fmPtr;
+ Tcl_Obj *cmdObj;
if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
return NULL;
@@ -1366,6 +1370,8 @@ TclOONewForwardMethod(
fmPtr = (ForwardMethod *) ckalloc(sizeof(ForwardMethod));
fmPtr->prefixObj = prefixObj;
+ Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);
+ fmPtr->fullyQualified = (strncmp(TclGetString(cmdObj), "::", 2) == 0);
Tcl_IncrRefCount(prefixObj);
return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj,
flags, &fwdMethodType, fmPtr);
@@ -1394,6 +1400,7 @@ InvokeForwardMethod(
ForwardMethod *fmPtr = clientData;
Tcl_Obj **argObjs, **prefixObjs;
int numPrefixes, len, skip = contextPtr->skip;
+ Command *cmdPtr;
/*
* Build the real list of arguments to use. Note that we know that the
@@ -1406,8 +1413,14 @@ InvokeForwardMethod(
argObjs = InitEnsembleRewrite(interp, objc, objv, skip,
numPrefixes, prefixObjs, &len);
+ if (fmPtr->fullyQualified) {
+ cmdPtr = NULL;
+ } else {
+ cmdPtr = (Command *) Tcl_FindCommand(interp, TclGetString(argObjs[0]),
+ contextPtr->oPtr->namespacePtr, 0 /* normal lookup */);
+ }
Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL);
- return Tcl_NREvalObjv(interp, len, argObjs, TCL_EVAL_INVOKE);
+ return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_INVOKE, cmdPtr);
}
static int
@@ -1452,6 +1465,7 @@ CloneForwardMethod(
ForwardMethod *fm2Ptr = (ForwardMethod *) ckalloc(sizeof(ForwardMethod));
fm2Ptr->prefixObj = fmPtr->prefixObj;
+ fm2Ptr->fullyQualified = fmPtr->fullyQualified;
Tcl_IncrRefCount(fm2Ptr->prefixObj);
*newClientData = fm2Ptr;
return TCL_OK;