0.pre8.9:

	The other half of the forward-referenced-classes-in-methods
		issue (again, thanks to Gerd Moellmann)
	... define and use CPL-OR-NIL rather than CLASS-PRECEDENCE-LIST,
		to accommodate the fact that some specializers might not
		be finalized

diff --git a/NEWS b/NEWS
index f3bbed6..faa9abc 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1624,8 +1624,11 @@ changes in sbcl-0.8.0 relative to sbcl-0.7.14
     private implementation detail, and no longer a semi-private MOP
     interface.
   * known functions, which cannot be open coded by backend, are
-    considered to be able to check types of their arguments. (reported
-    by Nathan J. Froyd)
+    considered to be able to check types of their arguments.
+    (reported by Nathan J. Froyd)
+  * fixed a bug in computing method discriminating functions: it is
+    now possible to define methods specialized on classes which have
+    forward-referenced superclasses.  (thanks to Gerd Moellmann)
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** COPY-ALIST now signals an error if its argument is a dotted
        list;

diff --git a/src/pcl/dfun.lisp b/src/pcl/dfun.lisp
index b1eec55..8ae016d 100644 (file)
--- a/src/pcl/dfun.lisp
+++ b/src/pcl/dfun.lisp
@@ -709,6 +709,10 @@ And so, we are saved.
          ((and (eq *boot-state* 'complete)
                (compute-applicable-methods-emf-std-p gf))
           (let* ((caching-p (use-caching-dfun-p gf))
+                 ;; KLUDGE: the only effect of this (when
+                 ;; *LAZY-DFUN-COMPUTE-P* is true, as it usually is)
+                 ;; is to signal an error when we try to add methods
+                 ;; with the wrong qualifiers to a generic function.
                  (classes-list (precompute-effective-methods
                                 gf caching-p
                                 (not *lazy-dfun-compute-p*))))
@@ -1322,6 +1326,12 @@ And so, we are saved.
       (mapcar (lambda (x) (position x lambda-list))
              argument-precedence-order)))
 
+(defun cpl-or-nil (class)
+  (if (eq *boot-state* 'complete)
+      (when (class-finalized-p class)
+        (class-precedence-list class))
+      (early-class-precedence-list class)))
+
 (defun saut-and (specl type)
   (let ((applicable nil)
        (possibly-applicable t))
@@ -1345,8 +1355,8 @@ And so, we are saved.
 
 (defun saut-not-class (specl ntype)
   (let* ((class (type-class specl))
-        (cpl (class-precedence-list class)))
-     (not (memq (cadr ntype) cpl))))
+        (cpl (cpl-or-nil class)))
+    (not (memq (cadr ntype) cpl))))
 
 (defun saut-not-prototype (specl ntype)
   (let* ((class (case (car specl)
@@ -1354,8 +1364,8 @@ And so, we are saved.
                  (class-eq  (cadr specl))
                  (prototype (cadr specl))
                  (class     (cadr specl))))
-        (cpl (class-precedence-list class)))
-     (not (memq (cadr ntype) cpl))))
+        (cpl (cpl-or-nil class)))
+    (not (memq (cadr ntype) cpl))))
 
 (defun saut-not-class-eq (specl ntype)
   (let ((class (case (car specl)
@@ -1369,9 +1379,7 @@ And so, we are saved.
     (t   t)))
 
 (defun class-applicable-using-class-p (specl type)
-  (let ((pred (memq specl (if (eq *boot-state* 'complete)
-                             (class-precedence-list type)
-                             (early-class-precedence-list type)))))
+  (let ((pred (memq specl (cpl-or-nil type))))
     (values pred
            (or pred
                (if (not *in-precompute-effective-methods-p*)
@@ -1393,7 +1401,7 @@ And so, we are saved.
     (class (class-applicable-using-class-p (cadr specl) (cadr type)))
     (t     (values nil (let ((class (type-class specl)))
                         (memq (cadr type)
-                              (class-precedence-list class)))))))
+                              (cpl-or-nil class)))))))
 
 (defun saut-class-eq (specl type)
   (if (eq (car specl) 'eql)

diff --git a/src/pcl/methods.lisp b/src/pcl/methods.lisp
index 5fd798f..06e0260 100644 (file)
--- a/src/pcl/methods.lisp
+++ b/src/pcl/methods.lisp
@@ -561,8 +561,8 @@
        (pushnew other-class (class-incompatible-superclass-list class))))))
 
 (defun superclasses-compatible-p (class1 class2)
-  (let ((cpl1 (class-precedence-list class1))
-       (cpl2 (class-precedence-list class2)))
+  (let ((cpl1 (cpl-or-nil class1))
+       (cpl2 (cpl-or-nil class2)))
     (dolist (sc1 cpl1 t)
       (dolist (ic (class-incompatible-superclass-list sc1))
        (when (memq ic cpl2)

diff --git a/tests/clos.impure-cload.lisp b/tests/clos.impure-cload.lisp
index 121e0db..beaa4ee 100644 (file)
--- a/tests/clos.impure-cload.lisp
+++ b/tests/clos.impure-cload.lisp
@@ -55,13 +55,13 @@
 (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)
+;;; specializers with forward-referenced superclasses used not to
+;;; work.
 (defclass specializer1 () ())
 (defclass specializer2 (forward-ref1) ())
 (defmethod baz ((x specializer2)) x)
 (defmethod baz ((x specializer1)) x)
+(assert (typep (baz (make-instance 'specializer1)) 'specializer1))
 \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 48bb52c..78d07cc 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.8"
+"0.pre8.9"