0.9.7.21:

	Make SB-PCL::MAP-ALL-CLASSES hit each class Once And Only Once.

diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp
index 15601a1..47debc0 100644 (file)
--- a/src/pcl/dfun.lisp
+++ b/src/pcl/dfun.lisp
@@ -1645,15 +1645,18 @@ Except see also BREAK-VICIOUS-METACIRCLE.  -- CSR, 2003-05-28
                            'specializer-applicable-using-type-p
                            type)))))
 
-(defun map-all-classes (function &optional (root t))
-  (let ((braid-p (or (eq *boot-state* 'braid)
+(defun map-all-classes (fun &optional (root t))
+  (let ((all-classes (make-hash-table :test 'eq))
+        (braid-p (or (eq *boot-state* 'braid)
                      (eq *boot-state* 'complete))))
     (labels ((do-class (class)
-               (mapc #'do-class
-                     (if braid-p
-                         (class-direct-subclasses class)
-                         (early-class-direct-subclasses class)))
-               (funcall function class)))
+               (unless (gethash class all-classes)
+                 (setf (gethash class all-classes) t)
+                 (funcall fun class)
+                 (mapc #'do-class
+                       (if braid-p
+                           (class-direct-subclasses class)
+                           (early-class-direct-subclasses class))))))
       (do-class (if (symbolp root)
                     (find-class root)
                     root)))))

diff --git a/tests/clos.pure.lisp b/tests/clos.pure.lisp
index 377c7e8..5a20e88 100644 (file)
--- a/tests/clos.pure.lisp
+++ b/tests/clos.pure.lisp
@@ -39,3 +39,10 @@
                             (simple-condition-format-arguments err)))
     (declare (ignore value))
     (assert (not format-err))))
+
+;;; another not (user-)observable behaviour: make sure that
+;;; sb-pcl::map-all-classes calls its function on each class once and
+;;; exactly once.
+(let (result)
+  (sb-pcl::map-all-classes (lambda (c) (push c result)))
+  (assert (equal result (remove-duplicates result))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 06701d6..0ffa9da 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.7.20"
+"0.9.7.21"