0.pre8.8:

	Partial bugfix for defining methods where some of the
		specializers are forward-referenced-classes
	... noted by James Anderson, fixed by Gerd Moellmann

diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp
index 4d81f4b..b1eec55 100644 (file)
--- a/src/pcl/dfun.lisp
+++ b/src/pcl/dfun.lisp
@@ -686,38 +686,54 @@ And so, we are saved.
 (defvar *lazy-dfun-compute-p* t)
 (defvar *early-p* nil)
 
+(defun finalize-specializers (gf)
+  (let ((all-finalized t))
+    (dolist (method (generic-function-methods gf))
+      (dolist (specializer (method-specializers method))
+       (when (and (classp specializer)
+                  (not (class-finalized-p specializer)))
+         (if (class-has-a-forward-referenced-superclass-p specializer)
+             (setq all-finalized nil)
+             (finalize-inheritance specializer)))))
+    all-finalized))
+
 (defun make-initial-dfun (gf)
   (let ((initial-dfun
         #'(instance-lambda (&rest args)
             (initial-dfun gf args))))
     (multiple-value-bind (dfun cache info)
-       (if (and (eq *boot-state* 'complete)
-                (compute-applicable-methods-emf-std-p gf))
-           (let* ((caching-p (use-caching-dfun-p gf))
-                  (classes-list (precompute-effective-methods
-                                 gf caching-p
-                                 (not *lazy-dfun-compute-p*))))
-             (if *lazy-dfun-compute-p*
-                 (cond ((use-dispatch-dfun-p gf caching-p)
-                        (values initial-dfun
-                                nil
-                                (initial-dispatch-dfun-info)))
-                       (caching-p
-                        (insure-caching-dfun gf)
-                        (values initial-dfun nil (initial-dfun-info)))
-                       (t
-                        (values initial-dfun nil (initial-dfun-info))))
-                 (make-final-dfun-internal gf classes-list)))
-           (let ((arg-info (if (early-gf-p gf)
-                               (early-gf-arg-info gf)
-                               (gf-arg-info gf)))
-                 (type nil))
-             (if (and (gf-precompute-dfun-and-emf-p arg-info)
-                      (setq type (final-accessor-dfun-type gf)))
-                 (if *early-p*
-                     (values (make-early-accessor gf type) nil nil)
-                     (make-final-accessor-dfun gf type))
-                 (values initial-dfun nil (initial-dfun-info)))))
+       (cond
+         ((and (eq *boot-state* 'complete)
+               (not (finalize-specializers gf)))
+          (values initial-dfun nil (initial-dfun-info)))
+         ((and (eq *boot-state* 'complete)
+               (compute-applicable-methods-emf-std-p gf))
+          (let* ((caching-p (use-caching-dfun-p gf))
+                 (classes-list (precompute-effective-methods
+                                gf caching-p
+                                (not *lazy-dfun-compute-p*))))
+            (if *lazy-dfun-compute-p*
+                (cond ((use-dispatch-dfun-p gf caching-p)
+                       (values initial-dfun
+                               nil
+                               (initial-dispatch-dfun-info)))
+                      (caching-p
+                       (insure-caching-dfun gf)
+                       (values initial-dfun nil (initial-dfun-info)))
+                      (t
+                       (values initial-dfun nil (initial-dfun-info))))
+                (make-final-dfun-internal gf classes-list))))
+         (t
+          (let ((arg-info (if (early-gf-p gf)
+                              (early-gf-arg-info gf)
+                              (gf-arg-info gf)))
+                (type nil))
+            (if (and (gf-precompute-dfun-and-emf-p arg-info)
+                     (setq type (final-accessor-dfun-type gf)))
+                (if *early-p*
+                    (values (make-early-accessor gf type) nil nil)
+                    (make-final-accessor-dfun gf type))
+                (values initial-dfun nil (initial-dfun-info))))))
       (set-dfun gf dfun cache info))))
 
 (defun make-early-accessor (gf type)

diff --git a/tests/clos.impure-cload.lisp b/tests/clos.impure-cload.lisp
index b5c96f0..121e0db 100644 (file)
--- a/tests/clos.impure-cload.lisp
+++ b/tests/clos.impure-cload.lisp
@@ -54,5 +54,14 @@
 (class-allocation-writer 4)
 (assert (= (class-allocation-reader) 4))
 \f
+;;; from James Anderson via Gerd Moellmann: defining methods with
+;;; forward-referenced specializers used not to work (FIXME: and also
+;;; calling said method with an instance of something else
+;;; [SPECIALIZER1, here] should work -- patch forthcoming)
+(defclass specializer1 () ())
+(defclass specializer2 (forward-ref1) ())
+(defmethod baz ((x specializer2)) x)
+(defmethod baz ((x specializer1)) x)
+\f
 ;;; success
 (sb-ext:quit :unix-status 104)
\ No newline at end of file

diff --git a/version.lisp-expr b/version.lisp-expr
index 354c137..48bb52c 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.pre8.7"
+"0.pre8.8"