From ded2af78dc3f04e6b0c41817a712516aa4caf62d Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Tue, 25 Mar 2003 16:30:56 +0000 Subject: [PATCH] 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 --- NEWS | 7 +++++-- src/pcl/dfun.lisp | 24 ++++++++++++++++-------- src/pcl/methods.lisp | 4 ++-- tests/clos.impure-cload.lisp | 6 +++--- version.lisp-expr | 2 +- 5 files changed, 27 insertions(+), 16 deletions(-) diff --git a/NEWS b/NEWS index f3bbed6..faa9abc 100644 --- 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 --- 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 --- 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 --- a/tests/clos.impure-cload.lisp +++ b/tests/clos.impure-cload.lisp @@ -55,13 +55,13 @@ (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) +;;; 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)) ;;; 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 --- 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" -- 1.7.10.4