Index: ChangeLog =================================================================== diff -u -rb34e7956fa495da43250c26f402ab5a34e72d96d -rb50baa47b65361cce5e09caa477fa065ce3e0826 --- ChangeLog (.../ChangeLog) (revision b34e7956fa495da43250c26f402ab5a34e72d96d) +++ ChangeLog (.../ChangeLog) (revision b50baa47b65361cce5e09caa477fa065ce3e0826) @@ -1,3 +1,9 @@ +2008-02-05: + - fix getAllClassMixinsOf to handle combinations of + transitive per class mixins and inheriting per-class + mixin via the class hierarchy, removed getAllSubClasses + - extend test cases + 2008-02-04: * Potential incompatibility: provide a uniform interface to the following info subcommands Index: generic/xotcl.c =================================================================== diff -u -rf37d836d9b24c8cdf9a44b29da6a2bd92dfd3716 -rb50baa47b65361cce5e09caa477fa065ce3e0826 --- generic/xotcl.c (.../xotcl.c) (revision f37d836d9b24c8cdf9a44b29da6a2bd92dfd3716) +++ generic/xotcl.c (.../xotcl.c) (revision b50baa47b65361cce5e09caa477fa065ce3e0826) @@ -1331,7 +1331,7 @@ */ cl->color = GRAY; - for (; sl != 0; sl = sl->next) { + for (; sl; sl = sl->next) { XOTclClass *sc = sl->cl; if (sc->color == GRAY) { cl->color = WHITE; return 0; } if (sc->color == WHITE && !TopoSort(sc, base, next)) { @@ -3335,34 +3335,23 @@ } /* - * recursively get all subclasses of a class into an initialized - * object ptr hashtable (TCL_ONE_WORD_KEYS) + * helper function for getAllClassMixinsOf to add classes to the + * result set, flagging test for matchObject as result */ static int -getAllSubClasses(Tcl_Interp *interp, Tcl_HashTable *destTable, XOTclClass *startCl, - int appendResult, char *pattern, XOTclObject *matchObject) { - XOTclClasses *sc; - int rc = 0; - - for (sc = startCl->sub; sc; sc = sc->next) { - if (sc->cl) { - int new; - if (matchObject && (XOTclObject *)sc->cl == matchObject) { - Tcl_SetIntObj(Tcl_GetObjResult(interp), 1); - return 1; - } - Tcl_CreateHashEntry(destTable, (char *)sc->cl, &new); - if (new) { - if (appendResult) { - AppendMatchingElement(interp, sc->cl->object.cmdName, pattern); - } - rc = getAllSubClasses(interp, destTable, sc->cl, appendResult, pattern, matchObject); - if (rc == 1) break; - } +addToResultSet(Tcl_Interp *interp, Tcl_HashTable *destTable, XOTclClass *cl, int *new, + int appendResult, char *pattern, XOTclObject *matchObject) { + Tcl_CreateHashEntry(destTable, (char *)cl, new); + if (*new) { + if (matchObject && matchObject == (XOTclObject *)cl) { + return 1; } + if (appendResult) { + AppendMatchingElement(interp, cl->object.cmdName, pattern); + } } - return rc; + return 0; } /* @@ -3371,41 +3360,56 @@ */ static int -getAllClassMixinsOf(Tcl_Interp *interp, Tcl_HashTable *destTable, XOTclClass *startCl, +getAllClassMixinsOf(Tcl_Interp *interp, Tcl_HashTable *destTable, XOTclClass *startCl, int isMixin, int appendResult, char *pattern, XOTclObject *matchObject) { - int rc = 0; + int rc = 0, new = 0; + XOTclClass *cl; + XOTclClasses *sc; + /* + fprintf(stderr, "startCl = %s, opt %p, isMixin %d\n", + ObjStr(startCl->object.cmdName),startCl->opt, isMixin); + */ + + /* + * the startCl is a per class mixin, add it to the result set + */ + if (isMixin) { + rc = addToResultSet(interp, destTable, startCl, &new, appendResult, pattern, matchObject); + if (rc == 1) {return rc;} + + /* + * check all subclasses of startCl for mixins + */ + for (sc = startCl->sub; sc; sc = sc->next) { + rc = getAllClassMixinsOf(interp, destTable, sc->cl, isMixin, appendResult, pattern, matchObject); + if (rc) {return rc;} + } + } + + /* + * check, if startCl is a per-class mixin of some other classes + */ if (startCl->opt) { XOTclCmdList *m; for (m = startCl->opt->isClassMixinOf; m; m = m->next) { - XOTclClass *cl; /* we should have no deleted commands in the list */ assert(Tcl_Command_cmdEpoch(m->cmdPtr) == 0); cl = XOTclGetClassFromCmdPtr(m->cmdPtr); - if (cl) { - int new; - if (matchObject && matchObject == (XOTclObject *)cl) { - return 1; - } - Tcl_CreateHashEntry(destTable, (char *)cl, &new); - if (new) { - /* if (new) fprintf (stderr, " -- %s (%s)\n", Tcl_GetCommandName(interp, m->cmdPtr), ObjStr(startCl->object.cmdName));*/ - if (appendResult) { - AppendMatchingElement(interp, cl->object.cmdName, pattern); - } - if (cl->sub) { - rc = getAllSubClasses(interp, destTable, cl, appendResult, pattern, matchObject); - if (rc) {return rc;} - } - rc = getAllClassMixinsOf(interp, destTable, cl, appendResult, pattern, matchObject); - if (rc) {return rc;} - } + assert(cl); + + rc = addToResultSet(interp, destTable, cl, &new, appendResult, pattern, matchObject); + if (rc == 1) {return rc;} + if (new) { + rc = getAllClassMixinsOf(interp, destTable, cl, 1, appendResult, pattern, matchObject); + if (rc) {return rc;} } } } + return rc; } @@ -3568,7 +3572,7 @@ */ Tcl_InitHashTable(commandTable, TCL_ONE_WORD_KEYS); MEM_COUNT_ALLOC("Tcl_InitHashTable", commandTable); - getAllClassMixinsOf(interp, commandTable, cl, 0, NULL, NULL); + getAllClassMixinsOf(interp, commandTable, cl, 1, 0, NULL, NULL); for (hPtr = Tcl_FirstHashEntry(commandTable, &hSrch); hPtr; hPtr = Tcl_NextHashEntry(&hSrch)) { @@ -10729,16 +10733,16 @@ Tcl_HashTable objTable, *commandTable = &objTable; MEM_COUNT_ALLOC("Tcl_InitHashTable", commandTable); Tcl_InitHashTable(commandTable, TCL_ONE_WORD_KEYS); - rc = getAllClassMixinsOf(interp, commandTable, cl, 1, pattern, matchObject); + rc = getAllClassMixinsOf(interp, commandTable, cl, 0, 1, pattern, matchObject); MEM_COUNT_FREE("Tcl_InitHashTable", commandTable); } else { rc = AppendMatchingElementsFromCmdList(interp, opt->isClassMixinOf, pattern, matchObject); } + if (matchObject) { + Tcl_SetObjResult(interp, rc ? matchObject->cmdName : XOTclGlobalObjects[XOTE_EMPTY]); + } } - if (matchObject) { - Tcl_SetObjResult(interp, rc ? matchObject->cmdName : XOTclGlobalObjects[XOTE_EMPTY]); - } return TCL_OK; } else if (!strcmp(cmdTail, "mixinguard")) { Index: generic/xotcl.h =================================================================== diff -u -rcedbcd6a70c433f37525ad01e254895b600db08b -rb50baa47b65361cce5e09caa477fa065ce3e0826 --- generic/xotcl.h (.../xotcl.h) (revision cedbcd6a70c433f37525ad01e254895b600db08b) +++ generic/xotcl.h (.../xotcl.h) (revision b50baa47b65361cce5e09caa477fa065ce3e0826) @@ -56,8 +56,6 @@ #define NDEBUG 1 */ - - /* activate/deacticate memory tracing #define XOTCL_MEM_TRACE 1 #define XOTCL_MEM_COUNT 1 Index: tests/mixinoftest.xotcl =================================================================== diff -u -ref3421c713c73a847d5d3a2b8c70aa720c725f47 -rb50baa47b65361cce5e09caa477fa065ce3e0826 --- tests/mixinoftest.xotcl (.../mixinoftest.xotcl) (revision ef3421c713c73a847d5d3a2b8c70aa720c725f47) +++ tests/mixinoftest.xotcl (.../mixinoftest.xotcl) (revision b50baa47b65361cce5e09caa477fa065ce3e0826) @@ -48,6 +48,7 @@ ########################################### # testing simple per class mixins ########################################### +::xotcl::test::case pcm Class A Class B -instmixin A Class C -superclass B @@ -69,6 +70,7 @@ ########################################### # testing transitive per class mixins ########################################### +::xotcl::test::case trans-pcm1 Class A Class B -instmixin A Class C -superclass B @@ -108,8 +110,68 @@ ########################################### -# testing transitive per class mixins (part 2) +# testing transitive per class mixins with subclasses ########################################### +::xotcl::test::case trans-pcm2 +Class X +Class D +Class C -superclass D +Class A -instmixin C +Class B -superclass A +B b1 + +? {C info instmixinof -closure} "::A ::B" +? {D info instmixinof -closure} "" +? {A info instmixinof -closure} "" +? {B info instmixinof -closure} "" +? {X info instmixinof -closure} "" +D instmixin X +? {C info instmixinof -closure} "::A ::B" +? {D info instmixinof -closure} "" +? {A info instmixinof -closure} "" +? {B info instmixinof -closure} "" +? {X info instmixinof -closure} "::D ::C ::A ::B" +? {b1 info precedence} "::C ::X ::D ::B ::A ::xotcl::Object" +B b2 +? {b2 info precedence} "::C ::X ::D ::B ::A ::xotcl::Object" + +foreach o {X D C A B b1 b2} {$o destroy} + +########################################### +# testing transitive per class mixins with subclasses +########################################### +::xotcl::test::case trans-pcm3 +Class A3 -superclass [Class A2 -superclass [Class A1]] +Class B3 -superclass [Class B2 -superclass [Class B1 -superclass [Class B0]]] +Class C3 -superclass [Class C2 -superclass [Class C1]] + +A2 instmixin B2 +B1 instmixin C2 + +? {A1 info instmixinof -closure} "" +? {A2 info instmixinof -closure} "" +? {A3 info instmixinof -closure} "" + +? {B0 info instmixinof -closure} "" +? {B1 info instmixinof -closure} "" +? {B2 info instmixinof -closure} "::A2 ::A3" +? {B3 info instmixinof -closure} "" + +? {C1 info instmixinof -closure} "" +? {C2 info instmixinof -closure} "::B1 ::B2 ::B3 ::A2 ::A3" +? {C3 info instmixinof -closure} "" + +foreach o {A1 A2 A3 B0 B1 B2 B3 C1 C2 C3} {$o destroy} + + + + + + +########################################### +# testing transitive per class mixins with destroy +########################################### +::xotcl::test::case pcm-trans-destroy-A Class A -instmixin [Class M] Class B -instmixin A Class C -superclass B @@ -142,8 +204,9 @@ foreach o {M C a1 b1 c1} { $o destroy } ########################################### -# testing transitive per class mixins (part 3) +# testing transitive per class mixins with destroy ########################################### +::xotcl::test::case pcm-trans-destroy-B Class A -instmixin [Class M] Class B -instmixin A Class C -superclass B @@ -175,6 +238,7 @@ ########################################### # testing simple per class mixins with redefinition ########################################### +::xotcl::test::case pcm-redefine Class A Class B -instmixin A Class C -superclass B @@ -209,6 +273,7 @@ # testing simple per class mixins with # redefinition and softrecreate ########################################### +::xotcl::test::case pcm-redefine-soft ::xotcl::configure softrecreate true Class A Class B -instmixin A