diff options
author | dgp <dgp@users.sourceforge.net> | 2018-06-04 13:08:54 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2018-06-04 13:08:54 (GMT) |
commit | 050e383cf2f4f6e67ba6030a187257e0c2c0b1e0 (patch) | |
tree | c8503d07c1c9cef078bbf8e61a99c043a051aebd /generic/tclOOCall.c | |
parent | 2db0464fd943cc115d69a8e62696704759a88ed2 (diff) | |
parent | ddd37fb237f275386ac83a0f5c31ce8a47d36405 (diff) | |
download | tcl-050e383cf2f4f6e67ba6030a187257e0c2c0b1e0.zip tcl-050e383cf2f4f6e67ba6030a187257e0c2c0b1e0.tar.gz tcl-050e383cf2f4f6e67ba6030a187257e0c2c0b1e0.tar.bz2 |
merge 8.7
Diffstat (limited to 'generic/tclOOCall.c')
-rw-r--r-- | generic/tclOOCall.c | 664 |
1 files changed, 461 insertions, 203 deletions
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index c093d82..1b4f587 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -47,6 +47,28 @@ struct ChainBuilder { !((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN)) /* + * Note that the flag bit PRIVATE_METHOD has a confusing name; it's just for + * Itcl's special type of private. + */ + +#define IS_PUBLIC(mPtr) \ + (((mPtr)->flags & PUBLIC_METHOD) != 0) +#define IS_UNEXPORTED(mPtr) \ + (((mPtr)->flags & SCOPE_FLAGS) == 0) +#define IS_ITCLPRIVATE(mPtr) \ + (((mPtr)->flags & PRIVATE_METHOD) != 0) +#define IS_PRIVATE(mPtr) \ + (((mPtr)->flags & TRUE_PRIVATE_METHOD) != 0) +#define WANT_PUBLIC(flags) \ + (((flags) & PUBLIC_METHOD) != 0) +#define WANT_UNEXPORTED(flags) \ + (((flags) & (PRIVATE_METHOD | TRUE_PRIVATE_METHOD)) == 0) +#define WANT_ITCLPRIVATE(flags) \ + (((flags) & PRIVATE_METHOD) != 0) +#define WANT_PRIVATE(flags) \ + (((flags) & TRUE_PRIVATE_METHOD) != 0) + +/* * Function declarations for things defined in this file. */ @@ -60,12 +82,26 @@ static inline void AddMethodToCallChain(Method *const mPtr, struct ChainBuilder *const cbPtr, Tcl_HashTable *const doneFilters, Class *const filterDecl, int flags); -static inline void AddSimpleChainToCallContext(Object *const oPtr, +static inline int AddInstancePrivateToCallContext(Object *const oPtr, + Tcl_Obj *const methodNameObj, + struct ChainBuilder *const cbPtr, int flags); +static inline void AddStandardMethodName(int flags, Tcl_Obj *namePtr, + Method *mPtr, Tcl_HashTable *namesPtr); +static inline void AddPrivateMethodNames(Tcl_HashTable *methodsTablePtr, + Tcl_HashTable *namesPtr); +static inline int AddSimpleChainToCallContext(Object *const oPtr, + Class *const contextCls, + Tcl_Obj *const methodNameObj, + struct ChainBuilder *const cbPtr, + Tcl_HashTable *const doneFilters, int flags, + Class *const filterDecl); +static int AddPrivatesFromClassChainToCallContext(Class *classPtr, + Class *const contextCls, Tcl_Obj *const methodNameObj, struct ChainBuilder *const cbPtr, Tcl_HashTable *const doneFilters, int flags, Class *const filterDecl); -static void AddSimpleClassChainToCallContext(Class *classPtr, +static int AddSimpleClassChainToCallContext(Class *classPtr, Tcl_Obj *const methodNameObj, struct ChainBuilder *const cbPtr, Tcl_HashTable *const doneFilters, int flags, @@ -78,6 +114,8 @@ static inline int IsStillValid(CallChain *callPtr, Object *oPtr, int flags, int reuseMask); static Tcl_NRPostProc ResetFilterFlags; static Tcl_NRPostProc SetFilterFlags; +static int SortMethodNames(Tcl_HashTable *namesPtr, int flags, + const char ***stringsPtr); static inline void StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr); /* @@ -364,6 +402,14 @@ FinalizeMethodRefs( int TclOOGetSortedMethodList( Object *oPtr, /* The object to get the method names for. */ + Object *contextObj, /* From what context object we are inquiring. + * NULL when the context shouldn't see + * object-level private methods. Note that + * flags can override this. */ + Class *contextCls, /* From what context class we are inquiring. + * NULL when the context shouldn't see + * class-level private methods. Note that + * flags can override this. */ int flags, /* Whether we just want the public method * names. */ const char ***stringsPtr) /* Where to write a pointer to the array of @@ -376,12 +422,10 @@ TclOOGetSortedMethodList( * at. Is set-like in nature and keyed by * pointer to class. */ FOREACH_HASH_DECLS; - int i; + int i, numStrings; Class *mixinPtr; Tcl_Obj *namePtr; Method *mPtr; - int isWantedIn; - void *isWanted; Tcl_InitObjHashTable(&names); Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS); @@ -398,18 +442,13 @@ TclOOGetSortedMethodList( if (oPtr->methodsPtr) { FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) { - int isNew; - - if ((mPtr->flags & PRIVATE_METHOD) && !(flags & PRIVATE_METHOD)) { + if (IS_PRIVATE(mPtr)) { continue; } - hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew); - if (isNew) { - isWantedIn = ((!(flags & PUBLIC_METHOD) - || mPtr->flags & PUBLIC_METHOD) ? IN_LIST : 0); - isWantedIn |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0); - Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn)); + if (IS_UNEXPORTED(mPtr) && !WANT_UNEXPORTED(flags)) { + continue; } + AddStandardMethodName(flags, namePtr, mPtr, &names); } } @@ -417,84 +456,46 @@ TclOOGetSortedMethodList( * Process method names due to private methods on the object's class. */ - if (flags & PRIVATE_METHOD) { + if (WANT_UNEXPORTED(flags)) { FOREACH_HASH(namePtr, mPtr, &oPtr->selfCls->classMethods) { - if (mPtr->flags & PRIVATE_METHOD) { - int isNew; - - hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew); - if (isNew) { - isWantedIn = IN_LIST; - if (mPtr->typePtr == NULL) { - isWantedIn |= NO_IMPLEMENTATION; - } - Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn)); - } else if (mPtr->typePtr != NULL) { - isWantedIn = PTR2INT(Tcl_GetHashValue(hPtr)); - if (isWantedIn & NO_IMPLEMENTATION) { - isWantedIn &= ~NO_IMPLEMENTATION; - Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn)); - } - } + if (IS_UNEXPORTED(mPtr)) { + AddStandardMethodName(flags, namePtr, mPtr, &names); } } } /* + * Process method names due to private methods on the context's object or + * class. Which must be correct if either are not NULL. + */ + + if (contextObj && contextObj->methodsPtr) { + AddPrivateMethodNames(contextObj->methodsPtr, &names); + } + if (contextCls) { + AddPrivateMethodNames(&contextCls->classMethods, &names); + } + + /* * Process (normal) method names from the class hierarchy and the mixin * hierarchy. */ AddClassMethodNames(oPtr->selfCls, flags, &names, &examinedClasses); FOREACH(mixinPtr, oPtr->mixins) { - AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, &names, + AddClassMethodNames(mixinPtr, flags | TRAVERSED_MIXIN, &names, &examinedClasses); } - Tcl_DeleteHashTable(&examinedClasses); - /* - * See how many (visible) method names there are. If none, we do not (and - * should not) try to sort the list of them. + * Tidy up, sort the names and resolve finally whether we really want + * them (processing export layering). */ - i = 0; - if (names.numEntries != 0) { - const char **strings; - - /* - * We need to build the list of methods to sort. We will be using - * qsort() for this, because it is very unlikely that the list will be - * heavily sorted when it is long enough to matter. - */ - - strings = ckalloc(sizeof(char *) * names.numEntries); - FOREACH_HASH(namePtr, isWanted, &names) { - if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) { - if (PTR2INT(isWanted) & NO_IMPLEMENTATION) { - continue; - } - strings[i++] = TclGetString(namePtr); - } - } - - /* - * Note that 'i' may well be less than names.numEntries when we are - * dealing with public method names. - */ - - if (i > 0) { - if (i > 1) { - qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr); - } - *stringsPtr = strings; - } else { - ckfree(strings); - } - } - + Tcl_DeleteHashTable(&examinedClasses); + numStrings = SortMethodNames(&names, flags, stringsPtr); Tcl_DeleteHashTable(&names); - return i; + return numStrings; } int @@ -511,10 +512,7 @@ TclOOGetSortedClassMethodList( /* Used to track what classes have been looked * at. Is set-like in nature and keyed by * pointer to class. */ - FOREACH_HASH_DECLS; - int i; - Tcl_Obj *namePtr; - void *isWanted; + int numStrings; Tcl_InitObjHashTable(&names); Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS); @@ -527,50 +525,100 @@ TclOOGetSortedClassMethodList( Tcl_DeleteHashTable(&examinedClasses); /* + * Process private method names if we should. [TIP 500] + */ + + if (WANT_PRIVATE(flags)) { + AddPrivateMethodNames(&clsPtr->classMethods, &names); + flags &= ~TRUE_PRIVATE_METHOD; + } + + /* + * Tidy up, sort the names and resolve finally whether we really want + * them (processing export layering). + */ + + numStrings = SortMethodNames(&names, flags, stringsPtr); + Tcl_DeleteHashTable(&names); + return numStrings; +} + +/* + * ---------------------------------------------------------------------- + * + * SortMethodNames -- + * + * Shared helper for TclOOGetSortedMethodList etc. that knows the method + * sorting rules. + * + * Returns: + * The length of the sorted list. + * + * ---------------------------------------------------------------------- + */ + +static int +SortMethodNames( + Tcl_HashTable *namesPtr, /* The table of names; unsorted, but contains + * whether the names are wanted and under what + * circumstances. */ + int flags, /* Whether we are looking for unexported + * methods. Full private methods are handled + * on insertion to the table. */ + const char ***stringsPtr) /* Where to store the sorted list of strings + * that we produce. ckalloced() */ +{ + const char **strings; + FOREACH_HASH_DECLS; + Tcl_Obj *namePtr; + void *isWanted; + int i = 0; + + /* * See how many (visible) method names there are. If none, we do not (and * should not) try to sort the list of them. */ - i = 0; - if (names.numEntries != 0) { - const char **strings; + if (namesPtr->numEntries == 0) { + *stringsPtr = NULL; + return 0; + } - /* - * We need to build the list of methods to sort. We will be using - * qsort() for this, because it is very unlikely that the list will be - * heavily sorted when it is long enough to matter. - */ + /* + * We need to build the list of methods to sort. We will be using qsort() + * for this, because it is very unlikely that the list will be heavily + * sorted when it is long enough to matter. + */ - strings = ckalloc(sizeof(char *) * names.numEntries); - FOREACH_HASH(namePtr, isWanted, &names) { - if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) { - if (PTR2INT(isWanted) & NO_IMPLEMENTATION) { - continue; - } - strings[i++] = TclGetString(namePtr); + strings = ckalloc(sizeof(char *) * namesPtr->numEntries); + FOREACH_HASH(namePtr, isWanted, namesPtr) { + if (!WANT_PUBLIC(flags) || (PTR2INT(isWanted) & IN_LIST)) { + if (PTR2INT(isWanted) & NO_IMPLEMENTATION) { + continue; } + strings[i++] = TclGetString(namePtr); } + } - /* - * Note that 'i' may well be less than names.numEntries when we are - * dealing with public method names. - */ + /* + * Note that 'i' may well be less than names.numEntries when we are + * dealing with public method names. We don't sort unless there's at least + * two method names. + */ - if (i > 0) { - if (i > 1) { - qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr); - } - *stringsPtr = strings; - } else { - ckfree(strings); + if (i > 0) { + if (i > 1) { + qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr); } + *stringsPtr = strings; + } else { + ckfree(strings); + *stringsPtr = NULL; } - - Tcl_DeleteHashTable(&names); return i; } -/* Comparator for GetSortedMethodList */ +/* Comparator for SortMethodNames */ static int CmpStr( const void *ptr1, @@ -579,7 +627,7 @@ CmpStr( const char **strPtr1 = (const char **) ptr1; const char **strPtr2 = (const char **) ptr2; - return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1)+1); + return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1) + 1); } /* @@ -612,6 +660,8 @@ AddClassMethodNames( * pointers to the classes, and the values are * immaterial. */ { + int i; + /* * If we've already started looking at this class, stop working on it now * to prevent repeated work. @@ -642,7 +692,6 @@ AddClassMethodNames( if (clsPtr->mixins.num != 0) { Class *mixinPtr; - int i; FOREACH(mixinPtr, clsPtr->mixins) { if (mixinPtr != clsPtr) { @@ -653,20 +702,7 @@ AddClassMethodNames( } FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) { - hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew); - if (isNew) { - int isWanted = (!(flags & PUBLIC_METHOD) - || (mPtr->flags & PUBLIC_METHOD)) ? IN_LIST : 0; - - isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0); - Tcl_SetHashValue(hPtr, INT2PTR(isWanted)); - } else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION) - && mPtr->typePtr != NULL) { - int isWanted = PTR2INT(Tcl_GetHashValue(hPtr)); - - isWanted &= ~NO_IMPLEMENTATION; - Tcl_SetHashValue(hPtr, INT2PTR(isWanted)); - } + AddStandardMethodName(flags, namePtr, mPtr, namesPtr); } if (clsPtr->superclasses.num != 1) { @@ -676,7 +712,6 @@ AddClassMethodNames( } if (clsPtr->superclasses.num != 0) { Class *superPtr; - int i; FOREACH(superPtr, clsPtr->superclasses) { AddClassMethodNames(superPtr, flags, namesPtr, @@ -688,19 +723,121 @@ AddClassMethodNames( /* * ---------------------------------------------------------------------- * + * AddPrivateMethodNames, AddStandardMethodName -- + * + * Factored-out helpers for the sorted name list production functions. + * + * ---------------------------------------------------------------------- + */ + +static inline void +AddPrivateMethodNames( + Tcl_HashTable *methodsTablePtr, + Tcl_HashTable *namesPtr) +{ + FOREACH_HASH_DECLS; + Method *mPtr; + Tcl_Obj *namePtr; + + FOREACH_HASH(namePtr, mPtr, methodsTablePtr) { + if (IS_PRIVATE(mPtr)) { + int isNew; + + hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew); + Tcl_SetHashValue(hPtr, INT2PTR(IN_LIST)); + } + } +} + +static inline void +AddStandardMethodName( + int flags, + Tcl_Obj *namePtr, + Method *mPtr, + Tcl_HashTable *namesPtr) +{ + if (!IS_PRIVATE(mPtr)) { + int isNew; + Tcl_HashEntry *hPtr = + Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew); + + if (isNew) { + int isWanted = (!WANT_PUBLIC(flags) || IS_PUBLIC(mPtr)) + ? IN_LIST : 0; + + isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0); + Tcl_SetHashValue(hPtr, INT2PTR(isWanted)); + } else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION) + && mPtr->typePtr != NULL) { + int isWanted = PTR2INT(Tcl_GetHashValue(hPtr)); + + isWanted &= ~NO_IMPLEMENTATION; + Tcl_SetHashValue(hPtr, INT2PTR(isWanted)); + } + } +} + +#undef IN_LIST +#undef NO_IMPLEMENTATION + +/* + * ---------------------------------------------------------------------- + * + * AddInstancePrivateToCallContext -- + * + * Add private methods from the instance. Called when the calling Tcl + * context is a TclOO method declared by an object that is the same as + * the current object. Returns true iff a private method was actually + * found and added to the call chain (as this suppresses caching). + * + * ---------------------------------------------------------------------- + */ + +static inline int +AddInstancePrivateToCallContext( + Object *const oPtr, /* Object to add call chain entries for. */ + Tcl_Obj *const methodName, /* Name of method to add the call chain + * entries for. */ + struct ChainBuilder *const cbPtr, + /* Where to add the call chain entries. */ + int flags) /* What sort of call chain are we building. */ +{ + Tcl_HashEntry *hPtr; + Method *mPtr; + int donePrivate = 0; + + if (oPtr->methodsPtr) { + hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodName); + if (hPtr != NULL) { + mPtr = Tcl_GetHashValue(hPtr); + if (IS_PRIVATE(mPtr)) { + AddMethodToCallChain(mPtr, cbPtr, NULL, NULL, flags); + donePrivate = 1; + } + } + } + return donePrivate; +} + +/* + * ---------------------------------------------------------------------- + * * AddSimpleChainToCallContext -- * * The core of the call-chain construction engine, this handles calling a * particular method on a particular object. Note that filters and * unknown handling are already handled by the logic that uses this - * function. + * function. Returns true if a private method was one of those found. * * ---------------------------------------------------------------------- */ -static inline void +static inline int AddSimpleChainToCallContext( Object *const oPtr, /* Object to add 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. */ @@ -714,44 +851,62 @@ AddSimpleChainToCallContext( * NULL, either the filter was declared by the * object or this isn't a filter. */ { - int i; + int i, foundPrivate = 0, blockedUnexported = 0; + Tcl_HashEntry *hPtr; + Method *mPtr; if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) { - Tcl_HashEntry *hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, - (char *) methodNameObj); + hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodNameObj); if (hPtr != NULL) { - Method *mPtr = Tcl_GetHashValue(hPtr); - - if (flags & PUBLIC_METHOD) { - if (!(mPtr->flags & PUBLIC_METHOD)) { - return; + mPtr = Tcl_GetHashValue(hPtr); + if (!IS_PRIVATE(mPtr)) { + if (WANT_PUBLIC(flags)) { + if (!IS_PUBLIC(mPtr)) { + blockedUnexported = 1; + } else { + flags |= DEFINITE_PUBLIC; + } } else { - flags |= DEFINITE_PUBLIC; + flags |= DEFINITE_PROTECTED; } - } else { - flags |= DEFINITE_PROTECTED; } } } if (!(flags & SPECIAL)) { - Tcl_HashEntry *hPtr; Class *mixinPtr; FOREACH(mixinPtr, oPtr->mixins) { - AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, cbPtr, - doneFilters, flags|TRAVERSED_MIXIN, filterDecl); + if (contextCls) { + foundPrivate |= AddPrivatesFromClassChainToCallContext( + mixinPtr, contextCls, methodNameObj, cbPtr, + doneFilters, flags|TRAVERSED_MIXIN, filterDecl); + } + foundPrivate |= AddSimpleClassChainToCallContext(mixinPtr, + methodNameObj, cbPtr, doneFilters, + flags | TRAVERSED_MIXIN, filterDecl); } - if (oPtr->methodsPtr) { + if (oPtr->methodsPtr && !blockedUnexported) { hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj); if (hPtr != NULL) { - AddMethodToCallChain(Tcl_GetHashValue(hPtr), cbPtr, - doneFilters, filterDecl, flags); + mPtr = Tcl_GetHashValue(hPtr); + if (!IS_PRIVATE(mPtr)) { + AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, + flags); + } } } } - AddSimpleClassChainToCallContext(oPtr->selfCls, methodNameObj, cbPtr, - doneFilters, flags, filterDecl); + if (contextCls) { + foundPrivate |= AddPrivatesFromClassChainToCallContext(oPtr->selfCls, + contextCls, methodNameObj, cbPtr, doneFilters, flags, + filterDecl); + } + if (!blockedUnexported) { + foundPrivate |= AddSimpleClassChainToCallContext(oPtr->selfCls, + methodNameObj, cbPtr, doneFilters, flags, filterDecl); + } + return foundPrivate; } /* @@ -814,8 +969,8 @@ AddMethodToCallChain( * should be sufficient for [incr Tcl] support though. */ - if (!(callPtr->flags & PRIVATE_METHOD) - && (mPtr->flags & PRIVATE_METHOD) + if (!WANT_UNEXPORTED(callPtr->flags) + && IS_UNEXPORTED(mPtr) && (mPtr->declaringClassPtr != NULL) && (mPtr->declaringClassPtr != cbPtr->oPtr->selfCls)) { return; @@ -856,7 +1011,7 @@ AddMethodToCallChain( if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) { callPtr->chain = - ckalloc(sizeof(struct MInvoke) * (callPtr->numChain+1)); + ckalloc(sizeof(struct MInvoke) * (callPtr->numChain + 1)); memcpy(callPtr->chain, callPtr->staticChain, sizeof(struct MInvoke) * callPtr->numChain); } else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) { @@ -955,6 +1110,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. */ @@ -962,7 +1123,7 @@ TclOOGetCallContext( CallContext *contextPtr; CallChain *callPtr; struct ChainBuilder cb; - int i, count, doFilters; + int i, count, doFilters, donePrivate = 0; Tcl_HashEntry *hPtr; Tcl_HashTable doneFilters; @@ -1003,7 +1164,7 @@ TclOOGetCallContext( */ const Tcl_ObjIntRep *irPtr; - const int reuseMask = ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD); + const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD); if ((irPtr = Tcl_FetchIntRep(cacheInThisObj, &methodNameType))) { callPtr = irPtr->twoPtrValue.ptr1; @@ -1055,10 +1216,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, + oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS, + NULL); + AddSimpleChainToCallContext(oPtr, NULL, + oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; callPtr->epoch = -1; if (callPtr->numChain == 0) { @@ -1087,10 +1249,10 @@ TclOOGetCallContext( OBJECT_MIXIN); } FOREACH(filterObj, oPtr->filters) { - AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, - BUILDING_MIXINS, NULL); - AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, 0, - NULL); + donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls, + filterObj, &cb, &doneFilters, BUILDING_MIXINS, NULL); + donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls, + filterObj, &cb, &doneFilters, 0, NULL); } AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters, BUILDING_MIXINS); @@ -1105,9 +1267,15 @@ TclOOGetCallContext( * handle class mixins right. */ - AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, - flags|BUILDING_MIXINS, NULL); - AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, flags, NULL); + if (oPtr == contextObj) { + donePrivate |= AddInstancePrivateToCallContext(oPtr, methodNameObj, + &cb, flags); + donePrivate |= (contextObj->flags & HAS_PRIVATE_METHODS); + } + donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls, + methodNameObj, &cb, NULL, flags|BUILDING_MIXINS, NULL); + donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls, + methodNameObj, &cb, NULL, flags, NULL); /* * Check to see if the method has no implementation. If so, we probably @@ -1125,17 +1293,18 @@ 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, + oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS, + NULL); + AddSimpleChainToCallContext(oPtr, NULL, + oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; callPtr->epoch = -1; if (count == callPtr->numChain) { TclOODeleteChain(callPtr); return NULL; } - } else if (doFilters) { + } else if (doFilters && !donePrivate) { if (hPtr == NULL) { if (oPtr->flags & USE_CLASS_CACHE) { if (oPtr->selfCls->classChainCache == NULL) { @@ -1241,8 +1410,7 @@ TclOOGetStereotypeCallChain( hPtr = Tcl_FindHashEntry(clsPtr->classChainCache, (char *) methodNameObj); if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) { - const int reuseMask = - ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD); + const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD); callPtr = Tcl_GetHashValue(hPtr); if (IsStillValid(callPtr, &obj, flags, reuseMask)) { @@ -1286,9 +1454,10 @@ TclOOGetStereotypeCallChain( * Add the actual method implementations. */ - AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL, + AddSimpleChainToCallContext(&obj, NULL, methodNameObj, &cb, NULL, flags|BUILDING_MIXINS, NULL); - AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL, flags, NULL); + AddSimpleChainToCallContext(&obj, NULL, methodNameObj, &cb, NULL, flags, + NULL); /* * Check to see if the method has no implementation. If so, we probably @@ -1297,10 +1466,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, fPtr->unknownMethodNameObj, + &cb, NULL, BUILDING_MIXINS, NULL); + AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj, + &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; callPtr->epoch = -1; if (count == callPtr->numChain) { @@ -1380,9 +1549,9 @@ AddClassFiltersToCallContext( (void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj, &isNew); if (isNew) { - AddSimpleChainToCallContext(oPtr, filterObj, cbPtr, + AddSimpleChainToCallContext(oPtr, NULL, filterObj, cbPtr, doneFilters, clearedFlags|BUILDING_MIXINS, clsPtr); - AddSimpleChainToCallContext(oPtr, filterObj, cbPtr, + AddSimpleChainToCallContext(oPtr, NULL, filterObj, cbPtr, doneFilters, clearedFlags, clsPtr); } } @@ -1409,6 +1578,87 @@ AddClassFiltersToCallContext( /* * ---------------------------------------------------------------------- * + * AddPrivatesFromClassChainToCallContext -- + * + * Helper for AddSimpleChainToCallContext that is used to find private + * methds and add them to the call chain. Returns true when a private + * method is found and added. [TIP 500] + * + * ---------------------------------------------------------------------- + */ + +static int +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. */ + Tcl_Obj *const methodName, /* 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 + * *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) { + if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls, + methodName, cbPtr, doneFilters, flags|TRAVERSED_MIXIN, + filterDecl)) { + return 1; + } + } + + if (classPtr == contextCls) { + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods, + (char *) methodName); + + if (hPtr != NULL) { + register Method *mPtr = Tcl_GetHashValue(hPtr); + + if (IS_PRIVATE(mPtr)) { + AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, + flags); + return 1; + } + } + } + + switch (classPtr->superclasses.num) { + case 1: + classPtr = classPtr->superclasses.list[0]; + goto tailRecurse; + default: + FOREACH(superPtr, classPtr->superclasses) { + if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls, + methodName, cbPtr, doneFilters, flags, filterDecl)) { + return 1; + } + } + case 0: + return 0; + } +} + +/* + * ---------------------------------------------------------------------- + * * AddSimpleClassChainToCallContext -- * * Construct a call-chain from a class hierarchy. @@ -1416,7 +1666,7 @@ AddClassFiltersToCallContext( * ---------------------------------------------------------------------- */ -static void +static int AddSimpleClassChainToCallContext( Class *classPtr, /* Class to add the call chain entries for. */ Tcl_Obj *const methodNameObj, @@ -1432,7 +1682,7 @@ AddSimpleClassChainToCallContext( * NULL, either the filter was declared by the * object or this isn't a filter. */ { - int i; + int i, privateDanger = 0; Class *superPtr; /* @@ -1445,8 +1695,9 @@ AddSimpleClassChainToCallContext( tailRecurse: FOREACH(superPtr, classPtr->mixins) { - AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr, - doneFilters, flags|TRAVERSED_MIXIN, filterDecl); + privateDanger |= AddSimpleClassChainToCallContext(superPtr, + methodNameObj, cbPtr, doneFilters, flags | TRAVERSED_MIXIN, + filterDecl); } if (flags & CONSTRUCTOR) { @@ -1460,21 +1711,26 @@ AddSimpleClassChainToCallContext( Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods, (char *) methodNameObj); + if (classPtr->flags & HAS_PRIVATE_METHODS) { + privateDanger |= 1; + } if (hPtr != NULL) { register Method *mPtr = Tcl_GetHashValue(hPtr); - if (!(flags & KNOWN_STATE)) { - if (flags & PUBLIC_METHOD) { - if (mPtr->flags & PUBLIC_METHOD) { + if (!IS_PRIVATE(mPtr)) { + if (!(flags & KNOWN_STATE)) { + if (flags & PUBLIC_METHOD) { + if (!IS_PUBLIC(mPtr)) { + return privateDanger; + } flags |= DEFINITE_PUBLIC; } else { - return; + flags |= DEFINITE_PROTECTED; } - } else { - flags |= DEFINITE_PROTECTED; } + AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, + flags); } - AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, flags); } } @@ -1484,11 +1740,11 @@ AddSimpleClassChainToCallContext( goto tailRecurse; default: FOREACH(superPtr, classPtr->superclasses) { - AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr, - doneFilters, flags, filterDecl); + privateDanger |= AddSimpleClassChainToCallContext(superPtr, + methodNameObj, cbPtr, doneFilters, flags, filterDecl); } case 0: - return; + return privateDanger; } } @@ -1508,7 +1764,7 @@ TclOORenderCallChain( Tcl_Interp *interp, CallChain *callPtr) { - Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral; + Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral, *privateLiteral; Tcl_Obj *resultObj, *descObjs[4], **objv; Foundation *fPtr = TclOOGetFoundation(interp); int i; @@ -1517,12 +1773,14 @@ TclOORenderCallChain( * Allocate the literals (potentially) used in our description. */ - filterLiteral = Tcl_NewStringObj("filter", -1); + TclNewLiteralStringObj(filterLiteral, "filter"); Tcl_IncrRefCount(filterLiteral); - methodLiteral = Tcl_NewStringObj("method", -1); + TclNewLiteralStringObj(methodLiteral, "method"); Tcl_IncrRefCount(methodLiteral); - objectLiteral = Tcl_NewStringObj("object", -1); + TclNewLiteralStringObj(objectLiteral, "object"); Tcl_IncrRefCount(objectLiteral); + TclNewLiteralStringObj(privateLiteral, "private"); + Tcl_IncrRefCount(privateLiteral); /* * Do the actual construction of the descriptions. They consist of a list @@ -1540,16 +1798,15 @@ TclOORenderCallChain( for (i=0 ; i<callPtr->numChain ; i++) { struct MInvoke *miPtr = &callPtr->chain[i]; - descObjs[0] = miPtr->isFilter - ? filterLiteral - : callPtr->flags & OO_UNKNOWN_METHOD - ? fPtr->unknownMethodNameObj - : methodLiteral; - descObjs[1] = callPtr->flags & CONSTRUCTOR - ? fPtr->constructorName - : callPtr->flags & DESTRUCTOR - ? fPtr->destructorName - : miPtr->mPtr->namePtr; + descObjs[0] = + miPtr->isFilter ? filterLiteral : + callPtr->flags & OO_UNKNOWN_METHOD ? fPtr->unknownMethodNameObj : + IS_PRIVATE(miPtr->mPtr) ? privateLiteral : + methodLiteral; + descObjs[1] = + callPtr->flags & CONSTRUCTOR ? fPtr->constructorName : + callPtr->flags & DESTRUCTOR ? fPtr->destructorName : + miPtr->mPtr->namePtr; descObjs[2] = miPtr->mPtr->declaringClassPtr ? Tcl_GetObjectName(interp, (Tcl_Object) miPtr->mPtr->declaringClassPtr->thisPtr) @@ -1567,6 +1824,7 @@ TclOORenderCallChain( Tcl_DecrRefCount(filterLiteral); Tcl_DecrRefCount(methodLiteral); Tcl_DecrRefCount(objectLiteral); + Tcl_DecrRefCount(privateLiteral); /* * Finish building the description and return it. |