From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Tue, 25 Mar 2003 15:39:41 +0000 (+0000)
Subject: 0.pre8.8:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=3b83d0a2bdd4c57656efda93e01de5bdf47e28a8;p=sbcl.git

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
--- 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
--- 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))
 
+;;; 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)
+
 ;;; 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
--- 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"