diff options
| -rw-r--r-- | generic/tclOOCall.c | 97 | ||||
| -rw-r--r-- | tests/ooNext2.test | 87 |
2 files changed, 158 insertions, 26 deletions
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 897f635..2a81091 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -38,6 +38,12 @@ struct ChainBuilder { #define DEFINITE_PUBLIC 0x200000 #define KNOWN_STATE (DEFINITE_PROTECTED | DEFINITE_PUBLIC) #define SPECIAL (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN) +#define BUILDING_MIXINS 0x400000 +#define TRAVERSED_MIXIN 0x800000 +#define OBJECT_MIXIN 0x1000000 +#define MIXIN_CONSISTENT(flags) \ + (((flags) & OBJECT_MIXIN) || \ + !((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN)) /* * Function declarations for things defined in this file. @@ -45,13 +51,13 @@ struct ChainBuilder { static void AddClassFiltersToCallContext(Object *const oPtr, Class *clsPtr, struct ChainBuilder *const cbPtr, - Tcl_HashTable *const doneFilters); + Tcl_HashTable *const doneFilters, int flags); static void AddClassMethodNames(Class *clsPtr, const int flags, Tcl_HashTable *const namesPtr); static inline void AddMethodToCallChain(Method *const mPtr, struct ChainBuilder *const cbPtr, Tcl_HashTable *const doneFilters, - Class *const filterDecl); + Class *const filterDecl, int flags); static inline void AddSimpleChainToCallContext(Object *const oPtr, Tcl_Obj *const methodNameObj, struct ChainBuilder *const cbPtr, @@ -434,7 +440,7 @@ TclOOGetSortedMethodList( AddClassMethodNames(oPtr->selfCls, flags, &names); FOREACH(mixinPtr, oPtr->mixins) { - AddClassMethodNames(mixinPtr, flags, &names); + AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, &names); } /* @@ -598,7 +604,7 @@ AddClassMethodNames( /* TODO: Beware of infinite loops! */ FOREACH(mixinPtr, clsPtr->mixins) { - AddClassMethodNames(mixinPtr, flags, namesPtr); + AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, namesPtr); } } @@ -695,13 +701,13 @@ AddSimpleChainToCallContext( FOREACH(mixinPtr, oPtr->mixins) { AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, cbPtr, - doneFilters, flags, filterDecl); + doneFilters, flags|TRAVERSED_MIXIN, filterDecl); } if (oPtr->methodsPtr) { hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj); if (hPtr != NULL) { AddMethodToCallChain(Tcl_GetHashValue(hPtr), cbPtr, - doneFilters, filterDecl); + doneFilters, filterDecl, flags); } } } @@ -732,9 +738,15 @@ AddMethodToCallChain( * processed. If NULL, not processing filters. * Note that this function does not update * this hashtable. */ - Class *const filterDecl) /* The class that declared the filter. If + 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 flags) /* Used to check if we're mixin-consistent + * only. Mixin-consistent means that either + * we're looking to add things from a mixin + * and we have passed a mixin, or we're not + * looking to add things from a mixin and have + * not passed a mixin. */ { register CallChain *callPtr = cbPtr->callChainPtr; int i; @@ -743,9 +755,11 @@ AddMethodToCallChain( * Return if this is just an entry used to record whether this is a public * method. If so, there's nothing real to call and so nothing to add to * the call chain. + * + * This is also where we enforce mixin-consistency. */ - if (mPtr == NULL || mPtr->typePtr == NULL) { + if (mPtr == NULL || mPtr->typePtr == NULL || !MIXIN_CONSISTENT(flags)) { return; } @@ -1001,6 +1015,8 @@ TclOOGetCallContext( if (flags & FORCE_UNKNOWN) { AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj, + &cb, NULL, BUILDING_MIXINS, NULL); + AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; callPtr->epoch = -1; @@ -1024,21 +1040,32 @@ TclOOGetCallContext( doFilters = 1; Tcl_InitObjHashTable(&doneFilters); FOREACH(mixinPtr, oPtr->mixins) { - AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters); + AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters, + TRAVERSED_MIXIN|BUILDING_MIXINS|OBJECT_MIXIN); + AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters, + OBJECT_MIXIN); } FOREACH(filterObj, oPtr->filters) { + AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, + BUILDING_MIXINS, NULL); AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, 0, NULL); } - AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters); + AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters, + BUILDING_MIXINS); + AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters, + 0); Tcl_DeleteHashTable(&doneFilters); } count = cb.filterLength = callPtr->numChain; /* - * Add the actual method implementations. + * Add the actual method implementations. We have to do this twice to + * handle class mixins right. */ + AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, + flags|BUILDING_MIXINS, NULL); AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, flags, NULL); /* @@ -1058,6 +1085,8 @@ TclOOGetCallContext( return NULL; } AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj, + &cb, NULL, BUILDING_MIXINS, NULL); + AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; callPtr->epoch = -1; @@ -1201,7 +1230,9 @@ TclOOGetStereotypeCallChain( */ Tcl_InitObjHashTable(&doneFilters); - AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters); + AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters, + BUILDING_MIXINS); + AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters, 0); Tcl_DeleteHashTable(&doneFilters); count = cb.filterLength = callPtr->numChain; @@ -1209,6 +1240,8 @@ TclOOGetStereotypeCallChain( * Add the actual method implementations. */ + AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL, + flags|BUILDING_MIXINS, NULL); AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL, flags, NULL); /* @@ -1219,6 +1252,8 @@ TclOOGetStereotypeCallChain( if (count == callPtr->numChain) { AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb, + NULL, BUILDING_MIXINS, NULL); + AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL); callPtr->flags |= OO_UNKNOWN_METHOD; callPtr->epoch = -1; @@ -1259,12 +1294,15 @@ AddClassFiltersToCallContext( Class *clsPtr, /* Class to get the filters from. */ struct ChainBuilder *const cbPtr, /* Context to fill with call chain entries. */ - Tcl_HashTable *const doneFilters) + Tcl_HashTable *const doneFilters, /* Where to record what filters have been * processed. Keys are objects, values are * ignored. */ + int flags) /* Whether we've gone along a mixin link + * yet. */ { - int i; + int i, clearedFlags = + flags & ~(TRAVERSED_MIXIN|OBJECT_MIXIN|BUILDING_MIXINS); Class *superPtr, *mixinPtr; Tcl_Obj *filterObj; @@ -1279,7 +1317,8 @@ AddClassFiltersToCallContext( */ FOREACH(mixinPtr, clsPtr->mixins) { - AddClassFiltersToCallContext(oPtr, mixinPtr, cbPtr, doneFilters); + AddClassFiltersToCallContext(oPtr, mixinPtr, cbPtr, doneFilters, + flags|TRAVERSED_MIXIN); } /* @@ -1288,13 +1327,18 @@ AddClassFiltersToCallContext( * override how filters work to extend their behaviour. */ - FOREACH(filterObj, clsPtr->filters) { - int isNew; + if (MIXIN_CONSISTENT(flags)) { + FOREACH(filterObj, clsPtr->filters) { + int isNew; - (void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj, &isNew); - if (isNew) { - AddSimpleChainToCallContext(oPtr, filterObj, cbPtr, doneFilters, - 0, clsPtr); + (void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj, + &isNew); + if (isNew) { + AddSimpleChainToCallContext(oPtr, filterObj, cbPtr, + doneFilters, clearedFlags|BUILDING_MIXINS, clsPtr); + AddSimpleChainToCallContext(oPtr, filterObj, cbPtr, + doneFilters, clearedFlags, clsPtr); + } } } @@ -1308,7 +1352,8 @@ AddClassFiltersToCallContext( goto tailRecurse; default: FOREACH(superPtr, clsPtr->superclasses) { - AddClassFiltersToCallContext(oPtr, superPtr, cbPtr, doneFilters); + AddClassFiltersToCallContext(oPtr, superPtr, cbPtr, doneFilters, + flags); } case 0: return; @@ -1355,16 +1400,16 @@ AddSimpleClassChainToCallContext( tailRecurse: FOREACH(superPtr, classPtr->mixins) { AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr, - doneFilters, flags, filterDecl); + doneFilters, flags|TRAVERSED_MIXIN, filterDecl); } if (flags & CONSTRUCTOR) { AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters, - filterDecl); + filterDecl, flags); } else if (flags & DESTRUCTOR) { AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters, - filterDecl); + filterDecl, flags); } else { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods, (char *) methodNameObj); @@ -1383,7 +1428,7 @@ AddSimpleClassChainToCallContext( flags |= DEFINITE_PROTECTED; } } - AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl); + AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, flags); } } diff --git a/tests/ooNext2.test b/tests/ooNext2.test index a47aa91..9a63577 100644 --- a/tests/ooNext2.test +++ b/tests/ooNext2.test @@ -526,6 +526,93 @@ test oo-call-1.19 {object call introspection - memory leaks} -setup { } -cleanup { leaktester destroy } -constraints memory -result 0 +test oo-call-1.20 {object call introspection - complex case} -setup { + oo::class create root +} -body { + oo::class create ::A { + superclass root + method x {} {} + } + oo::class create ::B { + superclass A + method x {} {} + } + oo::class create ::C { + superclass root + method x {} {} + mixin B + } + oo::class create ::D { + superclass C + method x {} {} + } + oo::class create ::E { + superclass root + method x {} {} + } + oo::class create ::F { + superclass E + method x {} {} + } + oo::class create ::G { + superclass root + method x {} {} + } + oo::class create ::H { + superclass G + method x {} {} + } + oo::define F mixin H + F create y + oo::objdefine y { + method x {} {} + mixin D + } + info object call y x +} -cleanup { + root destroy +} -result {{method x ::D method} {method x ::B method} {method x ::A method} {method x ::C method} {method x ::H method} {method x ::G method} {method x object method} {method x ::F method} {method x ::E method}} +test oo-call-1.21 {object call introspection - complex case} -setup { + oo::class create root +} -body { + oo::class create ::A { + superclass root + method y {} {} + filter y + } + oo::class create ::B { + superclass A + method y {} {} + } + oo::class create ::C { + superclass root + method x {} {} + mixin B + } + oo::class create ::D { + superclass C + filter x + } + oo::class create ::E { + superclass root + method y {} {} + method x {} {} + } + oo::class create ::F { + superclass E + method z {} {} + method q {} {} + } + F create y + oo::objdefine y { + method unknown {} {} + mixin D + filter q + } + info object call y z +} -cleanup { + root destroy +} -result {{filter x ::C method} {filter x ::E method} {filter y ::B method} {filter y ::A method} {filter y ::E method} {filter q ::F method} {method z ::F method}} test oo-call-2.1 {class call introspection} -setup { oo::class create root |