Index: generic/xotcl.c =================================================================== diff -u -r018ced50b0b8139c67310d99f9541e933b7a1f2d -r4486d6fcdfe92418d68bf73e9c75dc869b78902e --- generic/xotcl.c (.../xotcl.c) (revision 018ced50b0b8139c67310d99f9541e933b7a1f2d) +++ generic/xotcl.c (.../xotcl.c) (revision 4486d6fcdfe92418d68bf73e9c75dc869b78902e) @@ -1606,6 +1606,9 @@ if (!cl->opt) { cl->opt = NEW(XOTclClassOpt); memset(cl->opt, 0, sizeof(XOTclClassOpt)); + if (cl->object.flags & XOTCL_IS_CLASS) { + cl->opt->id = cl->object.id; /* probably a temporary solution */ + } } return cl->opt; } @@ -3261,6 +3264,7 @@ static void RemoveFromClassMixinsOf(Tcl_Command cmd, XOTclCmdList *cmdlist) { + for ( ; cmdlist; cmdlist = cmdlist->next) { XOTclClass *ncl = XOTclGetClassFromCmdPtr(cmdlist->cmdPtr); XOTclClassOpt *nclopt = ncl ? ncl->opt : NULL; @@ -3358,8 +3362,20 @@ MEM_COUNT_FREE("Tcl_InitHashTable", commandTable); Tcl_DeleteHashTable(commandTable); } - +static void +MixinResetOrderForAllInstances(Tcl_Interp *interp, XOTclClass *cl) { + XOTclClasses *sl = cl->sub; + XOTclClasses *sc; + + /* fprintf(stderr,"\t reset for %s\n",ObjStr(cl->object.cmdName));*/ + MixinResetOrderForInstances(interp, cl); + for (sc = sl; sc != 0; sc = sc->next) { + MixinResetOrderForAllInstances(interp, sc->cl); + } +} + + /* * if the class hierarchy or class mixins have changed -> * invalidate mixin entries in all dependent instances @@ -3423,8 +3439,9 @@ hPtr = Tcl_NextHashEntry(&hSrch)) { char *key = Tcl_GetHashKey(commandTable, hPtr); XOTclClass *ncl = XOTclpGetClass(interp, key); + /* fprintf(stderr,"Got %s, reset for ncl %p\n",key,ncl);*/ if (ncl) { - MixinResetOrderForInstances(interp, ncl); + MixinResetOrderForAllInstances(interp, ncl); } } MEM_COUNT_FREE("Tcl_InitHashTable", commandTable); @@ -7377,8 +7394,7 @@ /* * Remove this class from all isClassMixinOf lists and clear the instmixin list */ - - RemoveFromClassMixinsOf(cl->object.id, clopt->instmixins); + RemoveFromClassMixinsOf(clopt->id, clopt->instmixins); CmdListRemoveList(&clopt->instmixins, GuardDel); MixinInvalidateObjOrders(interp, cl); @@ -7391,14 +7407,14 @@ * Remove this class from all mixin lists and clear the isObjectMixinOf list */ - RemoveFromMixins(cl->object.id, clopt->isObjectMixinOf); + RemoveFromMixins(clopt->id, clopt->isObjectMixinOf); CmdListRemoveList(&clopt->isObjectMixinOf, GuardDel); /* * Remove this class from all instmixin lists and clear the isClassMixinOf list */ - RemoveFromInstmixins(cl->object.id, clopt->isClassMixinOf); + RemoveFromInstmixins(clopt->id, clopt->isClassMixinOf); CmdListRemoveList(&clopt->isClassMixinOf, GuardDel); } /* remove dependent filters of this class from all subclasses*/ Index: generic/xotclInt.h =================================================================== diff -u -r018ced50b0b8139c67310d99f9541e933b7a1f2d -r4486d6fcdfe92418d68bf73e9c75dc869b78902e --- generic/xotclInt.h (.../xotclInt.h) (revision 018ced50b0b8139c67310d99f9541e933b7a1f2d) +++ generic/xotclInt.h (.../xotclInt.h) (revision 4486d6fcdfe92418d68bf73e9c75dc869b78902e) @@ -501,6 +501,7 @@ #ifdef XOTCL_OBJECTDATA Tcl_HashTable* objectdata; #endif + Tcl_Command id; ClientData clientData; } XOTclClassOpt; Index: tests/mixinoftest.xotcl =================================================================== diff -u -rab458c36e113c61d73756a960d97a30ea12834e4 -r4486d6fcdfe92418d68bf73e9c75dc869b78902e --- tests/mixinoftest.xotcl (.../mixinoftest.xotcl) (revision ab458c36e113c61d73756a960d97a30ea12834e4) +++ tests/mixinoftest.xotcl (.../mixinoftest.xotcl) (revision 4486d6fcdfe92418d68bf73e9c75dc869b78902e) @@ -52,6 +52,7 @@ Class B -instmixin A Class C -superclass B C c1 + ? {B instmixin} ::A ? {B info instmixin} ::A ? {A info instmixinof} ::B @@ -61,33 +62,182 @@ ? {A info instmixinof} "" ? {c1 info precedence} "::C ::xotcl::Object" -# the following destroy crashes A destroy C destroy c1 destroy ########################################### +# testing transitive per class mixins +########################################### +Class A +Class B -instmixin A +Class C -superclass B +A instmixin [Class M] + +A a1 +B b1 +C c1 + +? {B instmixin} ::A +? {B info instmixin} ::A +? {A info instmixinof} ::B +? {a1 info precedence} "::M ::A ::xotcl::Object" +? {b1 info precedence} "::M ::A ::B ::xotcl::Object" +? {c1 info precedence} "::M ::A ::C ::B ::xotcl::Object" + +# Wie werden transitive instmixin behandelt? +# M ist ein instmixin von A, A ist ein instmixin von B, +# so würde ich erwarten, dass M auch ein transitives instmixin +# von A ist. Sollte das instmixinof nicht +# - das Ergebnis von getAllClassMixinsOf liefern? +# - getAllClassMixinsOf nicht auch die subklassen inkludieren +# (siehe MixinResetOrderForAllInstances) +#? {M info instmixinof} "::A ::B" oder "::A ::B ::C"" +#? {M info instmixinof} "::A ::B" + +M destroy +? {a1 info precedence} "::A ::xotcl::Object" +? {b1 info precedence} "::A ::B ::xotcl::Object" +? {c1 info precedence} "::A ::C ::B ::xotcl::Object" + +B destroy +? {A info instmixinof} "" +? {c1 info precedence} "::C ::xotcl::Object" + +foreach o {A C a1 b1 c1} { + $o destroy +} + + +########################################### +# testing transitive per class mixins (part 2) +########################################### +Class A -instmixin [Class M] +Class B -instmixin A +Class C -superclass B + +A a1 +B b1 +C c1 + +? {B instmixin} ::A +? {B info instmixin} ::A +? {A info instmixinof} ::B +? {a1 info precedence} "::M ::A ::xotcl::Object" +? {b1 info precedence} "::M ::A ::B ::xotcl::Object" +? {c1 info precedence} "::M ::A ::C ::B ::xotcl::Object" + +A destroy +? {a1 info precedence} "::xotcl::Object" +? {b1 info precedence} "::B ::xotcl::Object" +? {c1 info precedence} "::C ::B ::xotcl::Object" +#? {M info instmixinof} "????" + +B destroy +? {M info instmixinof} "" +? {c1 info precedence} "::C ::xotcl::Object" + +foreach o {M C a1 b1 c1} { + $o destroy +} + +########################################### +# testing transitive per class mixins (part 3) +########################################### +Class A -instmixin [Class M] +Class B -instmixin A +Class C -superclass B + +A a1 +B b1 +C c1 + +? {B instmixin} ::A +? {B info instmixin} ::A +? {A info instmixinof} ::B +? {a1 info precedence} "::M ::A ::xotcl::Object" +? {b1 info precedence} "::M ::A ::B ::xotcl::Object" +? {c1 info precedence} "::M ::A ::C ::B ::xotcl::Object" + +B destroy +? {a1 info precedence} "::M ::A ::xotcl::Object" +? {b1 info precedence} "::xotcl::Object" +? {c1 info precedence} "::C ::xotcl::Object" + +? {A info instmixinof} "" +#? {M info instmixinof} "???" +? {c1 info precedence} "::C ::xotcl::Object" + +foreach o {M C a1 b1 c1} { + $o destroy +} + +########################################### # testing simple per class mixins with redefinition ########################################### Class A Class B -instmixin A Class C -superclass B C c1 + ? {B instmixin} ::A ? {B info instmixin} ::A ? {A info instmixinof} ::B ? {c1 info precedence} "::A ::C ::B ::xotcl::Object" +? {B info heritage} "::xotcl::Object" +? {C info heritage} "::B ::xotcl::Object" Class B -instmixin A + +? {B info heritage} "::xotcl::Object" +? {C info heritage} "::xotcl::Object" ? {B instmixin} ::A ? {B info instmixin} ::A ? {A info instmixinof} ::B +? {c1 info precedence} "::C ::xotcl::Object" + +B destroy +? {A info instmixinof} "" +? {c1 info precedence} "::C ::xotcl::Object" + +A destroy +C destroy +c1 destroy + + +########################################### +# testing simple per class mixins with +# redefinition and softrecreate +########################################### +::xotcl::configure softrecreate true +Class A +Class B -instmixin A +Class C -superclass B +C c1 + +? {B instmixin} ::A +? {B info instmixin} ::A +? {A info instmixinof} ::B ? {c1 info precedence} "::A ::C ::B ::xotcl::Object" +? {C info heritage} "::B ::xotcl::Object" +? {B info heritage} "::xotcl::Object" +Class B -instmixin A +? {C info heritage} "::B ::xotcl::Object" +? {B info heritage} "::xotcl::Object" +? {B info instmixin} ::A +? {A info instmixinof} ::B +? {c1 info precedence} "::A ::C ::B ::xotcl::Object" + B destroy ? {A info instmixinof} "" ? {c1 info precedence} "::C ::xotcl::Object" A destroy C destroy -c1 destroy \ No newline at end of file +c1 destroy + +#foreach o [::xotcl::test::Test info instances] {$o destroy} +#::xotcl::test::Test destroy +#puts [lsort [::xotcl::Object allinstances]] +