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

[Erik Huelsmann]

Author: ehuelsmann
Date: Mon Jan 18 15:12:34 2010
New Revision: 12391

Log:
Prevent duplicate subclasses: only push new classes
  not already present in the list.

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

Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/clos.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/clos.lisp	Mon Jan 18 15:12:34 2010
@@ -520,7 +520,7 @@
                     (list (find-class 'standard-object)))))
     (setf (class-direct-superclasses class) supers)
     (dolist (superclass supers)
-      (push class (class-direct-subclasses superclass))))
+      (pushnew class (class-direct-subclasses superclass))))
   (let ((slots (mapcar #'(lambda (slot-properties)
                           (apply #'make-direct-slot-definition class slot-properties))
                        direct-slots)))