[armedbear-cvs] r12661 - trunk/abcl/src/org/armedbear/lisp

[Alessio Stalla]

Author: astalla
Date: Sun May  9 10:58:36 2010
New Revision: 12661

Log:
Fix computation of the class precedence list for Java classes in case of multiple occurrences of the same interface in the class hierarchy.


Modified:
   trunk/abcl/src/org/armedbear/lisp/java.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/java.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/java.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/java.lisp	Sun May  9 10:58:36 2010
@@ -348,13 +348,16 @@
 	 jclass (mop::ensure-class
 		 (make-symbol (jclass-name jclass))
 		 :metaclass (find-class 'java-class)
-		 :direct-superclasses (mapcar #'ensure-java-class
-					      (remove-duplicates
-					       (delete nil
-						       (concatenate 'list
-								    (list (jclass-superclass jclass))
-								    (jclass-interfaces jclass)))
-					       :key #'jclass-name :test #'string=))
+		 :direct-superclasses
+		 (let ((supers
+			(mapcar #'ensure-java-class
+				(delete nil
+					(concatenate 'list
+						     (list (jclass-superclass jclass))
+						     (jclass-interfaces jclass))))))
+		   (if (jclass-interface-p jclass)
+		       (append supers (list (find-class 'java-object)))
+		       supers))
 		 :java-class jclass)))))
 
 (defmethod mop::compute-class-precedence-list ((class java-class))
@@ -373,7 +376,7 @@
    Note: Java interfaces are not sorted among themselves in any way, so if a
    gf is specialized on two different interfaces and you apply it to an object that
    implements both, it is unspecified which method will be called."
-  (let ((cpl (call-next-method)))
+  (let ((cpl (nreverse (mop::collect-superclasses* class))))
     (flet ((score (class)
 	     (if (not (typep class 'java-class))
 		 4