summaryrefslogtreecommitdiffstats
path: root/generic/tclOOCall.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclOOCall.c')
-rw-r--r--generic/tclOOCall.c156
1 files changed, 124 insertions, 32 deletions
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index aa30808..55f7e5b 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -60,6 +60,13 @@ static inline void AddMethodToCallChain(Method *const mPtr,
Tcl_HashTable *const doneFilters,
Class *const filterDecl, int flags);
static inline void AddSimpleChainToCallContext(Object *const oPtr,
+ Object *const contextObj, Class *const contextCls,
+ Tcl_Obj *const methodNameObj,
+ struct ChainBuilder *const cbPtr,
+ Tcl_HashTable *const doneFilters, int flags,
+ Class *const filterDecl);
+static void AddPrivatesFromClassChainToCallContext(Class *classPtr,
+ Class *const contextCls,
Tcl_Obj *const methodNameObj,
struct ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters, int flags,
@@ -703,6 +710,12 @@ AddClassMethodNames(
static inline void
AddSimpleChainToCallContext(
Object *const oPtr, /* Object to add call chain entries for. */
+ Object *const contextObj, /* Context object; when equal to oPtr, it
+ * means that private methods may also be
+ * added. [TIP 500] */
+ Class *const contextCls, /* Context class; the currently considered
+ * class is equal to this, private methods may
+ * also be added. [TIP 500] */
Tcl_Obj *const methodNameObj,
/* Name of method to add the call chain
* entries for. */
@@ -720,7 +733,7 @@ AddSimpleChainToCallContext(
Tcl_HashEntry *hPtr;
Method *mPtr;
- if (flags & OBJECT_PRIVATE_METHOD && oPtr->methodsPtr) {
+ if ((oPtr == contextObj) && oPtr->methodsPtr) {
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodNameObj);
if (hPtr != NULL) {
@@ -730,7 +743,6 @@ AddSimpleChainToCallContext(
flags);
}
}
- flags &= ~OBJECT_PRIVATE_METHOD;
flags |= DEFINITE_PROTECTED;
} else if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) {
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodNameObj);
@@ -752,6 +764,11 @@ AddSimpleChainToCallContext(
Class *mixinPtr;
FOREACH(mixinPtr, oPtr->mixins) {
+ if (contextCls) {
+ AddPrivatesFromClassChainToCallContext(mixinPtr, contextCls,
+ methodNameObj, cbPtr, doneFilters,
+ flags|TRAVERSED_MIXIN, filterDecl);
+ }
AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, cbPtr,
doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
}
@@ -766,6 +783,10 @@ AddSimpleChainToCallContext(
}
}
}
+ if (contextCls) {
+ AddPrivatesFromClassChainToCallContext(oPtr->selfCls, contextCls,
+ methodNameObj, cbPtr, doneFilters, flags, filterDecl);
+ }
AddSimpleClassChainToCallContext(oPtr->selfCls, methodNameObj, cbPtr,
doneFilters, flags, filterDecl);
}
@@ -971,6 +992,12 @@ TclOOGetCallContext(
* Only the bits PUBLIC_METHOD, CONSTRUCTOR,
* PRIVATE_METHOD, DESTRUCTOR and
* FILTER_HANDLING are useful. */
+ Object *contextObj, /* Context object; when equal to oPtr, it
+ * means that private methods may also be
+ * added. [TIP 500] */
+ Class *contextCls, /* Context class; the currently considered
+ * class is equal to this, private methods may
+ * also be added. [TIP 500] */
Tcl_Obj *cacheInThisObj) /* What object to cache in, or NULL if it is
* to be in the same object as the
* methodNameObj. */
@@ -1070,10 +1097,11 @@ TclOOGetCallContext(
*/
if (flags & FORCE_UNKNOWN) {
- AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
- &cb, NULL, BUILDING_MIXINS, NULL);
- AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
- &cb, NULL, 0, NULL);
+ AddSimpleChainToCallContext(oPtr, NULL, NULL,
+ oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
+ NULL);
+ AddSimpleChainToCallContext(oPtr, NULL, NULL,
+ oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
callPtr->flags |= OO_UNKNOWN_METHOD;
callPtr->epoch = -1;
if (callPtr->numChain == 0) {
@@ -1102,10 +1130,10 @@ TclOOGetCallContext(
OBJECT_MIXIN);
}
FOREACH(filterObj, oPtr->filters) {
- AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters,
- BUILDING_MIXINS, NULL);
- AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, 0,
- NULL);
+ AddSimpleChainToCallContext(oPtr, contextObj, contextCls,
+ filterObj, &cb, &doneFilters, BUILDING_MIXINS, NULL);
+ AddSimpleChainToCallContext(oPtr, contextObj, contextCls,
+ filterObj, &cb, &doneFilters, 0, NULL);
}
AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
BUILDING_MIXINS);
@@ -1120,9 +1148,10 @@ TclOOGetCallContext(
* handle class mixins right.
*/
- AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL,
- flags|BUILDING_MIXINS, NULL);
- AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, flags, NULL);
+ AddSimpleChainToCallContext(oPtr, contextObj, contextCls, methodNameObj,
+ &cb, NULL, flags|BUILDING_MIXINS, NULL);
+ AddSimpleChainToCallContext(oPtr, contextObj, contextCls, methodNameObj,
+ &cb, NULL, flags, NULL);
/*
* Check to see if the method has no implementation. If so, we probably
@@ -1140,10 +1169,11 @@ TclOOGetCallContext(
TclOODeleteChain(callPtr);
return NULL;
}
- AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
- &cb, NULL, BUILDING_MIXINS, NULL);
- AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
- &cb, NULL, 0, NULL);
+ AddSimpleChainToCallContext(oPtr, NULL, NULL,
+ oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
+ NULL);
+ AddSimpleChainToCallContext(oPtr, NULL, NULL,
+ oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
callPtr->flags |= OO_UNKNOWN_METHOD;
callPtr->epoch = -1;
if (count == callPtr->numChain) {
@@ -1301,9 +1331,10 @@ TclOOGetStereotypeCallChain(
* Add the actual method implementations.
*/
- AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL,
+ AddSimpleChainToCallContext(&obj, NULL, NULL, methodNameObj, &cb, NULL,
flags|BUILDING_MIXINS, NULL);
- AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL, flags, NULL);
+ AddSimpleChainToCallContext(&obj, NULL, NULL, methodNameObj, &cb, NULL,
+ flags, NULL);
/*
* Check to see if the method has no implementation. If so, we probably
@@ -1312,10 +1343,10 @@ TclOOGetStereotypeCallChain(
*/
if (count == callPtr->numChain) {
- AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
- NULL, BUILDING_MIXINS, NULL);
- AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
- NULL, 0, NULL);
+ AddSimpleChainToCallContext(&obj, NULL, NULL,
+ fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS, NULL);
+ AddSimpleChainToCallContext(&obj, NULL, NULL,
+ fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
callPtr->flags |= OO_UNKNOWN_METHOD;
callPtr->epoch = -1;
if (count == callPtr->numChain) {
@@ -1395,9 +1426,9 @@ AddClassFiltersToCallContext(
(void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj,
&isNew);
if (isNew) {
- AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
+ AddSimpleChainToCallContext(oPtr, NULL, NULL, filterObj, cbPtr,
doneFilters, clearedFlags|BUILDING_MIXINS, clsPtr);
- AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
+ AddSimpleChainToCallContext(oPtr, NULL, NULL, filterObj, cbPtr,
doneFilters, clearedFlags, clsPtr);
}
}
@@ -1432,8 +1463,11 @@ AddClassFiltersToCallContext(
*/
static void
-AddSimpleClassChainToCallContext(
+AddPrivatesFromClassChainToCallContext(
Class *classPtr, /* Class to add the call chain entries for. */
+ Class *const contextCls, /* Context class; the currently considered
+ * class is equal to this, private methods may
+ * also be added. [TIP 500] */
Tcl_Obj *const methodNameObj,
/* Name of method to add the call chain
* entries for. */
@@ -1447,10 +1481,70 @@ AddSimpleClassChainToCallContext(
* NULL, either the filter was declared by the
* object or this isn't a filter. */
{
- int i, private = (flags & CLASS_PRIVATE_METHOD);
+ int i;
Class *superPtr;
- flags &= ~CLASS_PRIVATE_METHOD;
+ /*
+ * We hard-code the tail-recursive form. It's by far the most common case
+ * *and* it is much more gentle on the stack.
+ *
+ * Note that mixins must be processed before the main class hierarchy.
+ * [Bug 1998221]
+ */
+
+ tailRecurse:
+ FOREACH(superPtr, classPtr->mixins) {
+ AddPrivatesFromClassChainToCallContext(superPtr, contextCls,
+ methodNameObj, cbPtr, doneFilters, flags|TRAVERSED_MIXIN,
+ filterDecl);
+ }
+
+ if (classPtr == contextCls) {
+ Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
+ (char *) methodNameObj);
+
+ if (hPtr != NULL) {
+ register Method *mPtr = Tcl_GetHashValue(hPtr);
+
+ if (mPtr->flags & TRUE_PRIVATE_METHOD) {
+ AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
+ flags);
+ }
+ }
+ }
+
+ switch (classPtr->superclasses.num) {
+ case 1:
+ classPtr = classPtr->superclasses.list[0];
+ goto tailRecurse;
+ default:
+ FOREACH(superPtr, classPtr->superclasses) {
+ AddPrivatesFromClassChainToCallContext(superPtr, contextCls,
+ methodNameObj, cbPtr, doneFilters, flags, filterDecl);
+ }
+ case 0:
+ return;
+ }
+}
+
+static void
+AddSimpleClassChainToCallContext(
+ Class *classPtr, /* Class to add the call chain entries for. */
+ Tcl_Obj *const methodNameObj,
+ /* Name of method to add the call chain
+ * entries for. */
+ struct ChainBuilder *const cbPtr,
+ /* Where to add the call chain entries. */
+ Tcl_HashTable *const doneFilters,
+ /* Where to record what call chain entries
+ * have been processed. */
+ int flags, /* What sort of call chain are we building. */
+ Class *const filterDecl) /* The class that declared the filter. If
+ * NULL, either the filter was declared by the
+ * object or this isn't a filter. */
+{
+ int i;
+ Class *superPtr;
/*
* We hard-code the tail-recursive form. It's by far the most common case
@@ -1480,9 +1574,7 @@ AddSimpleClassChainToCallContext(
if (hPtr != NULL) {
register Method *mPtr = Tcl_GetHashValue(hPtr);
- if (private && mPtr->flags & TRUE_PRIVATE_METHOD) {
- flags |= DEFINITE_PROTECTED;
- } else if (!(flags & KNOWN_STATE)) {
+ if (!(flags & KNOWN_STATE)) {
if (flags & PUBLIC_METHOD) {
if (mPtr->flags & PUBLIC_METHOD) {
flags |= DEFINITE_PUBLIC;
@@ -1493,7 +1585,7 @@ AddSimpleClassChainToCallContext(
flags |= DEFINITE_PROTECTED;
}
}
- if (private || !(mPtr->flags & TRUE_PRIVATE_METHOD)) {
+ if (!(mPtr->flags & TRUE_PRIVATE_METHOD)) {
AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
flags);
}
generated by cgit v0.12 at 2024-10-21 11:05:26 (GMT)