[1a56550e96] Ensure that method list introspection finds methods from mixins in all cases.

2 files changed, 79 insertions, 20 deletions

diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index ac0b94d..3e4f561 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -53,7 +53,8 @@ static void		AddClassFiltersToCallContext(Object *const oPtr,
 			    Class *clsPtr, struct ChainBuilder *const cbPtr,
 			    Tcl_HashTable *const doneFilters, int flags);
 static void		AddClassMethodNames(Class *clsPtr, const int flags,
-			    Tcl_HashTable *const namesPtr);
+			    Tcl_HashTable *const namesPtr,
+			    Tcl_HashTable *const examinedClassesPtr);
 static inline void	AddMethodToCallChain(Method *const mPtr,
 			    struct ChainBuilder *const cbPtr,
 			    Tcl_HashTable *const doneFilters,
@@ -367,6 +368,10 @@ TclOOGetSortedMethodList(
 {
     Tcl_HashTable names;	/* Tcl_Obj* method name to "wanted in list"
 				 * mapping. */
+    Tcl_HashTable examinedClasses;
+				/* 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;
     Class *mixinPtr;
@@ -376,6 +381,7 @@ TclOOGetSortedMethodList(
     void *isWanted;
 
     Tcl_InitObjHashTable(&names);
+    Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
 
     /*
      * Name the bits used in the names table values.
@@ -436,11 +442,14 @@ TclOOGetSortedMethodList(
      * hierarchy.
      */
 
-    AddClassMethodNames(oPtr->selfCls, flags, &names);
+    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.
@@ -495,18 +504,24 @@ TclOOGetSortedClassMethodList(
 {
     Tcl_HashTable names;	/* Tcl_Obj* method name to "wanted in list"
 				 * mapping. */
+    Tcl_HashTable examinedClasses;
+				/* 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;
 
     Tcl_InitObjHashTable(&names);
+    Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
 
     /*
      * Process method names from the class hierarchy and the mixin hierarchy.
      */
 
-    AddClassMethodNames(clsPtr, flags, &names);
+    AddClassMethodNames(clsPtr, flags, &names, &examinedClasses);
+    Tcl_DeleteHashTable(&examinedClasses);
 
     /*
      * See how many (visible) method names there are. If none, we do not (and
@@ -581,39 +596,60 @@ AddClassMethodNames(
     Class *clsPtr,		/* Class to get method names from. */
     const int flags,		/* Whether we are interested in just the
 				 * public method names. */
-    Tcl_HashTable *const namesPtr)
+    Tcl_HashTable *const namesPtr,
 				/* Reference to the hash table to put the
 				 * information in. The hash table maps the
 				 * Tcl_Obj * method name to an integral value
 				 * describing whether the method is wanted.
 				 * This ensures that public/private override
-				 * semantics are handled correctly.*/
+				 * semantics are handled correctly. */
+    Tcl_HashTable *const examinedClassesPtr)
+				/* Hash table that tracks what classes have
+				 * already been looked at. The keys are the
+				 * pointers to the classes, and the values are
+				 * immaterial. */
 {
     /*
+     * If we've already started looking at this class, stop working on it now
+     * to prevent repeated work.
+     */
+
+    if (Tcl_FindHashEntry(examinedClassesPtr, (char *) clsPtr)) {
+	return;
+    }
+
+    /*
      * Scope all declarations so that the compiler can stand a good chance of
      * making the recursive step highly efficient. We also hand-implement the
      * tail-recursive case using a while loop; C compilers typically cannot do
      * tail-recursion optimization usefully.
      */
 
-    if (clsPtr->mixins.num != 0) {
-	Class *mixinPtr;
-	int i;
-
-	/* TODO: Beware of infinite loops! */
-	FOREACH(mixinPtr, clsPtr->mixins) {
-	    AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, namesPtr);
-	}
-    }
-
     while (1) {
 	FOREACH_HASH_DECLS;
 	Tcl_Obj *namePtr;
 	Method *mPtr;
+	int isNew;
 
-	FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
-	    int isNew;
+	(void) Tcl_CreateHashEntry(examinedClassesPtr, (char *) clsPtr,
+		&isNew);
+	if (!isNew) {
+	    break;
+	}
+
+	if (clsPtr->mixins.num != 0) {
+	    Class *mixinPtr;
+	    int i;
 
+	    FOREACH(mixinPtr, clsPtr->mixins) {
+		if (mixinPtr != clsPtr) {
+		    AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN,
+			    namesPtr, examinedClassesPtr);
+		}
+	    }
+	}
+
+	FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
 	    hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
 	    if (isNew) {
 		int isWanted = (!(flags & PUBLIC_METHOD)
@@ -640,7 +676,8 @@ AddClassMethodNames(
 	int i;
 
 	FOREACH(superPtr, clsPtr->superclasses) {
-	    AddClassMethodNames(superPtr, flags, namesPtr);
+	    AddClassMethodNames(superPtr, flags, namesPtr,
+		    examinedClassesPtr);
 	}
     }
 }
diff --git a/tests/oo.test b/tests/oo.test
index 5f87837..b538b60 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -3800,7 +3800,29 @@ test oo-35.4 {Bug 593baa032c: mixins list teardown} {
     oo::class create D {mixin B}
     namespace eval [info object namespace D] [list [namespace which B] destroy]
 } {}
-
+test oo-35.5 {Bug 1a56550e96: introspectors must traverse mixin links correctly} -setup {
+    oo::class create base {
+	unexport destroy
+    }
+} -body {
+    oo::class create C {
+	superclass base
+	method c {} {}
+    }
+    oo::class create D {
+	superclass base
+	mixin C
+	method d {} {}
+    }
+    oo::class create E {
+	superclass D
+	method e {} {}
+    }
+    E create e1
+    list [lsort [info class methods E -all]] [lsort [info object methods e1 -all]]
+} -cleanup {
+    base destroy
+} -result {{c d e} {c d e}}
 test oo-36.1 {TIP #470: introspection within oo::define} {
     oo::define oo::object self
 } ::oo::object