Index: TODO =================================================================== diff -u -N -re90e59865348906790e496aa960ef57837456e9e -re4cc1570b184d6ae7f6d9f8daaa783e1df470e88 --- TODO (.../TODO) (revision e90e59865348906790e496aa960ef57837456e9e) +++ TODO (.../TODO) (revision e4cc1570b184d6ae7f6d9f8daaa783e1df470e88) @@ -2691,13 +2691,15 @@ * code cleanup - extended regression test +- nsf.c: + * ensure that explicit per-object-mixins are kept at the front in "info + heritage" order and in "info precedence" when classes are added as + POMs and PCMs + * extended regression test TODO: -- check again, of the nodup elimination in - MixinComputeOrderFullList() is ok, maybe the duplicate elimination - in info heritage should be based on something like - MixinComputeOrder() based on CmdListAdd() +- MixinComputeOrderFullList() could receive a flag to store source classes in checkList - if the check on eg. info-heritage-circular in test/info.method.tcl fails, we get an exception. Index: generic/nsf.c =================================================================== diff -u -N -re90e59865348906790e496aa960ef57837456e9e -re4cc1570b184d6ae7f6d9f8daaa783e1df470e88 --- generic/nsf.c (.../nsf.c) (revision e90e59865348906790e496aa960ef57837456e9e) +++ generic/nsf.c (.../nsf.c) (revision e4cc1570b184d6ae7f6d9f8daaa783e1df470e88) @@ -1330,7 +1330,7 @@ /* *---------------------------------------------------------------------- - * NsfClassListNoDup -- + * NsfClassListAddNoDup -- * * Add class list entry to the specified list without duplicates. In case * the initial list is empty, *firstPtrPtr is updated as well. @@ -1345,7 +1345,7 @@ */ static NsfClasses ** -NsfClassListNoDup(NsfClasses **firstPtrPtr, NsfClass *cl, ClientData clientData, int *new) { +NsfClassListAddNoDup(NsfClasses **firstPtrPtr, NsfClass *cl, ClientData clientData, int *new) { NsfClasses *l = *firstPtrPtr, *element = NULL, **newPtr = &element; if (l) { @@ -5065,30 +5065,30 @@ for (m = *mixinList; m; m = m->nextPtr) { NsfClass *mCl = NsfGetClassFromCmdPtr(m->cmdPtr); + if (mCl) { for (pl = ComputeOrder(mCl, mCl->order, Super); pl; pl = pl->nextPtr) { - //fprintf(stderr, " %s, ", ClassName(pl->cl)); if ((pl->cl->object.flags & NSF_IS_ROOT_CLASS) == 0) { NsfClassOpt *opt = pl->cl->opt; - if (opt && opt->classmixins) { - /* - * Compute transitively the (class) mixin classes of this - * added class. - */ - /*fprintf(stderr, "find %p %s in checklist %p\n", pl->cl, ClassName(pl->cl), *checkList);*/ - if (!NsfClassListFind(*checkList, pl->cl)) { - NsfClassListAdd(checkList, pl->cl, NULL); - /*fprintf(stderr, "+++ transitive %s\n", ClassName(pl->cl));*/ - MixinComputeOrderFullList(interp, &opt->classmixins, mixinClasses, - checkList, level+1); - } else { - /*fprintf(stderr, "+++ dont add %s\n", ClassName(pl->cl));*/ + //fprintf(stderr, "find %p %s in checklist 1 %p\n", pl->cl, ClassName(pl->cl), *checkList); + if (NsfClassListFind(*checkList, pl->cl)) { + //fprintf(stderr, "+++ never add %s\n", ClassName(pl->cl)); + } else { + if (opt && opt->classmixins) { + /* + * Compute transitively the (class) mixin classes of this + * added class. + */ + NsfClassListAdd(checkList, pl->cl, NULL); + /*fprintf(stderr, "+++ transitive %s\n", ClassName(pl->cl));*/ + MixinComputeOrderFullList(interp, &opt->classmixins, mixinClasses, + checkList, level+1); } - } - /*fprintf(stderr, "+++ add to mixinClasses %p path: %s clPtr %p\n", - mixinClasses, ClassName(pl->cl), clPtr);*/ - clPtr = NsfClassListNoDup(clPtr, pl->cl, m->clientData, NULL); + /*fprintf(stderr, "+++ add to mixinClasses %p path: %s clPtr %p\n", + mixinClasses, ClassName(pl->cl), clPtr);*/ + clPtr = NsfClassListAddNoDup(clPtr, pl->cl, m->clientData, NULL); + } } } } @@ -5158,18 +5158,33 @@ */ static void MixinComputeOrder(Tcl_Interp *interp, NsfObject *object) { - NsfClasses *fullList, *checkList = NULL, *mixinClasses = NULL, *nextCl, - *checker, *guardChecker; + NsfClasses *fullList, *checkList = NULL, *mixinClasses = NULL, *clPtr; if (object->mixinOrder) MixinResetOrder(object); - /* append per-obj mixins */ + /* Append per-obj mixins */ if (object->opt) { + NsfCmdList *m; + MixinComputeOrderFullList(interp, &object->opt->mixins, &mixinClasses, &checkList, 1); + /* + * Add per-object mixins to checkList to avoid that theses classes in the + * class mixins. + * + * TODO: we could add this already in MixinComputeOrderFullList() if we + * provide an additional flag. + */ + for (m = object->opt->mixins; m; m = m->nextPtr) { + NsfClass *mCl = NsfGetClassFromCmdPtr(m->cmdPtr); + if (mCl) { + NsfClassListAddNoDup(&checkList, mCl, NULL, NULL); + } + } } /*fprintf(stderr, "%s ", ObjectName(object)); - NsfClassListPrint("MixinComputeOrder poms", mixinClasses);*/ + NsfClassListPrint("MixinComputeOrder poms", mixinClasses); + NsfClassListPrint("MixinComputeOrder poms checkList", checkList);*/ /* append per-class mixins */ NsfClassListAddPerClassMixins(interp, object->cl, &mixinClasses, &checkList); @@ -5179,30 +5194,27 @@ CmdListPrint(interp, "mixinOrder", object->mixinOrder);*/ NsfClassListFree(checkList); - fullList = mixinClasses; /* * Don't add duplicates or classes of the precedence order to the resulting * list. */ - while (mixinClasses) { - NsfClass *cl = mixinClasses->cl; + for (clPtr = mixinClasses; clPtr; clPtr = clPtr->nextPtr) { + NsfClass *cl = clPtr->cl; + NsfClasses *checker; /*fprintf(stderr, "--- Work on %s\n", ClassName(cl)); CmdListPrint(interp, "mixinOrder", object->mixinOrder);*/ - checker = nextCl = mixinClasses->nextPtr; - checker = NsfClassListFind(checker, cl); - /*fprintf(stderr, "--- checking %s found %p \n", ClassName(cl), checker);*/ + checker = NsfClassListFind(clPtr->nextPtr, cl); /* * if checker is set, it is a duplicate and ignored */ if (checker == NULL) { /* check object->cl hierachy */ checker = NsfClassListFind(ComputeOrder(object->cl, object->cl->order, Super), cl); - /*fprintf(stderr, "--- checking 2 %s found %p \n", ClassName(cl), checker);*/ /* * if checker is set, it was found in the class hierarchy and it is ignored */ @@ -5220,12 +5232,12 @@ * We require the first matching guard of the full list in the new * client data */ - guardChecker = NsfClassListFind(fullList, cl); - if (guardChecker) { - new->clientData = guardChecker->clientData; + checker = NsfClassListFind(fullList, cl); + if (checker) { + new->clientData = checker->clientData; } } - mixinClasses = nextCl; + } /* ... and free the memory of the full list */ @@ -18936,7 +18948,8 @@ if (withMixins) { NsfClassListAddPerClassMixins(interp, cl, &mixinClasses, &checkList); for (pl = mixinClasses; pl; pl = pl->nextPtr) { - if (!NsfClassListFind(intrinsic, pl->cl)) { + if (NsfClassListFind(pl->nextPtr, pl->cl) == NULL && + NsfClassListFind(intrinsic, pl->cl) == NULL) { AppendMatchingElement(interp, pl->cl->object.cmdName, pattern); } } Index: library/xotcl/tests/testx.xotcl =================================================================== diff -u -N -re90e59865348906790e496aa960ef57837456e9e -re4cc1570b184d6ae7f6d9f8daaa783e1df470e88 --- library/xotcl/tests/testx.xotcl (.../testx.xotcl) (revision e90e59865348906790e496aa960ef57837456e9e) +++ library/xotcl/tests/testx.xotcl (.../testx.xotcl) (revision e4cc1570b184d6ae7f6d9f8daaa783e1df470e88) @@ -888,7 +888,7 @@ Bird instmixin {{Fly -guard {[my age]>2 && ![my istype Penguine]}} Sing} foreach bird {tweedy pingo donald lora} { $bird fly } - + ::errorCheck [set ::r] [list \ {::tweedy ::Parrot (1 years): how should i fly?} \ {::pingo ::Penguine (5 years): how should i fly?} \ @@ -940,13 +940,13 @@ lappend ::r "$i [eval $i]" } + ::errorCheck [Bird info instmixin -guards] \ + {::PCM-start {::Fly -guard {[my age]>2 && ![my istype Penguine]}} ::Sing ::PCM-end} pingo1 + ::errorCheck [pingo info mixin -guards] \ + {::POM-start {::Fly -guard {[my age]>2}} ::Sing ::POM-end} pingo2 + ::errorCheck [pingo info mixin -order -guards] \ + {::POM-start {::Fly -guard {[my age]>2}} ::Sing ::POM-end ::PCM-start ::PCM-end} pingo3 - ::errorCheck [set ::r] [list \ - {Bird info instmixin -guards ::PCM-start {::Fly -guard {[my age]>2 && ![my istype Penguine]}} ::Sing ::PCM-end} \ - {pingo info mixin -guards ::POM-start {::Fly -guard {[my age]>2}} ::Sing ::POM-end} \ - {pingo info mixin -order -guards ::POM-start ::POM-end ::PCM-start {::Fly -guard {[my age]>2}} ::Sing ::PCM-end}] \ - {Same Mixin Guard ... Info} - set ::r "" pingo fly ::errorCheck [set ::r] [list \ @@ -2107,12 +2107,12 @@ B instmixin {M3 M1 M1 M4} b mixin {M1 M1 M4} - ::errorCheck [b info mixin] "::M1 ::M4" "Mixin Info: -no dups" - ::errorCheck [b info precedence] "::M3 ::M1 ::M4 ::M2 ::B ::A ::xotcl::Object" "Mixin Info: -no dups" - ::errorCheck [b info mixin -order] "::M3 ::M1 ::M4 ::M2" "Mixin Info: -order option" + ::errorCheck [b info mixin] "::M1 ::M4" "Mixin Info: -no dups1" + ::errorCheck [b info precedence] "::M1 ::M4 ::M3 ::M2 ::B ::A ::xotcl::Object" "Mixin Info: -no dups2" + ::errorCheck [b info mixin -order] "::M1 ::M4 ::M3 ::M2" "Mixin Info: -order option1" ::errorCheck [B info instmixin]-[b info mixin] "::M3 ::M1 ::M4-::M1 ::M4" "Mixin Info: no duplicates" B instmixin {} - ::errorCheck [b info mixin -order] "::M1 ::M4 ::M2" "Mixin Info: -order option" + ::errorCheck [b info mixin -order] "::M1 ::M4 ::M2" "Mixin Info: -order option2" set ::r "" Class X11 -instproc test {args} { @@ -2288,6 +2288,10 @@ C c c mixin {AppMixin3 AppMixin2} + ::errorCheck [c info precedence] \ + "::AppMixin3 ::AppMixin2 ::AppMixin1 ::RefinedMixin1 ::RefinedMixin2 ::GeneralMixin ::C ::A ::B ::xotcl::Object" \ + "mixin precedence" + set r [c aProc ARGS1 ARGS2] ::errorCheck $mixinResult \ " ::AppMixin1 ::RefinedMixin1 ::RefinedMixin2 ::GeneralMixin ::C ::A" \ Index: tests/info-method.test =================================================================== diff -u -N -r360b4b02e10e3720651af50bad75ba9c3957bb43 -re4cc1570b184d6ae7f6d9f8daaa783e1df470e88 --- tests/info-method.test (.../info-method.test) (revision 360b4b02e10e3720651af50bad75ba9c3957bb43) +++ tests/info-method.test (.../info-method.test) (revision e4cc1570b184d6ae7f6d9f8daaa783e1df470e88) @@ -547,11 +547,16 @@ ? {A info heritage} "::O ::nx::Object" ? {B info heritage} "::A ::O ::nx::Object" ? {M3 info heritage} "::B ::A ::O ::nx::Object" + A mixin M3 + ? {A info heritage} "::B ::M3 ::O ::nx::Object" ? {B info heritage} "::M3 ::A ::O ::nx::Object" - ? {M3 info heritage} "::B ::A ::O ::nx::Object" + M3 create m1 + ? {m1 info precedence} "::B ::A ::O ::M3 ::nx::Object" + ? {M3 info heritage} "::B ::A ::O ::nx::Object" + B mixin M3 ? {B info heritage} "::M3 ::A ::O ::nx::Object" } @@ -609,7 +614,34 @@ # PCM, therefore the classes mixed in by POMS are not at the front # of the list. # - ? {b1 info precedence} "::M3 ::M1 ::M4 ::M2 ::B ::A ::nx::Object" - #? {b1 info precedence} "::M1 ::M4 ::M3 ::M2 ::B ::A ::nx::Object" + puts stderr =====1 + #? {b1 info precedence} "::M3 ::M1 ::M4 ::M2 ::B ::A ::nx::Object" + + ? {b1 info precedence} "::M1 ::M4 ::M3 ::M2 ::B ::A ::nx::Object" + puts stderr =====2 } +# +# per-object mixin with implied classes +# +nx::Test case info-heritage-multimix { + Class create A + Class create B -superclass A + Class create C + Class create PCM -superclass A + C create c1 + + ? {c1 info precedence} "::C ::nx::Object" + + # ::A is an implied class + c1 mixin B + ? {c1 info precedence} "::B ::A ::C ::nx::Object" + + # ::A is as well implied by ::PCM + C mixin PCM + ? {C info heritage} "::PCM ::A ::nx::Object" + + # ::A is not ordered after ::B but after ::PCM + ? {c1 info precedence} "::B ::PCM ::A ::C ::nx::Object" + +} \ No newline at end of file