0.7.9.14:

	Fix overeager checking for duplicate primary methods in
		non-standard method combinations
		(entomotomy reference:
		define-method-combination-duplicate-method-checking-too-eager
		once someone gets round to creating that page)
	... thanks to Wolfhard Buss and Gerd Moellmann
	Comment (adapted from Gerd Moellmann) explaining the paths taken
		to get to SB-PCL::FORCE-CACHE-FLUSHES

diff --git a/src/pcl/defcombin.lisp b/src/pcl/defcombin.lisp
index 5d173bd..97472ca 100644 (file)
--- a/src/pcl/defcombin.lisp
+++ b/src/pcl/defcombin.lisp
@@ -274,14 +274,15 @@
            (push name names)
            (push specializer-cache specializer-caches)
            (push `((or ,@tests)
-                     (if  (equal ,specializer-cache .specializers.)
-                          (return-from .long-method-combination-function.
-                            '(error "More than one method of type ~S ~
+                   (if (and (equal ,specializer-cache .specializers.)
+                            (not (null .specializers.)))
+                       (return-from .long-method-combination-function.
+                         '(error "More than one method of type ~S ~
                                      with the same specializers."
-                                    ',name))
-                          (setq ,specializer-cache .specializers.))
-                     (push .method. ,name))
-                   cond-clauses)
+                                  ',name))
+                       (setq ,specializer-cache .specializers.))
+                   (push .method. ,name))
+                 cond-clauses)
            (when required
              (push `(when (null ,name)
                         (return-from .long-method-combination-function.
@@ -304,7 +305,7 @@
       (dolist (.method. .applicable-methods.)
        (let ((.qualifiers. (method-qualifiers .method.))
              (.specializers. (method-specializers .method.)))
-         (progn .qualifiers. .specializers.)
+         (declare (ignorable .qualifiers. .specializers.))
          (cond ,@(nreverse cond-clauses))))
       ,@(nreverse required-checks)
       ,@(nreverse order-cleanups)

diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index ef6f9cf..cfa1c62 100644 (file)
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -1048,6 +1048,25 @@
     (or (eq new-super-meta-class *the-class-std-class*)
        (eq (class-of class) new-super-meta-class))))
 \f
+;;; What this does depends on which of the four possible values of
+;;; LAYOUT-INVALID the PCL wrapper has; the simplest case is when it
+;;; is (:FLUSH <wrapper>) or (:OBSOLETE <wrapper>), when there is
+;;; nothing to do, as the new wrapper has already been created.  If
+;;; LAYOUT-INVALID returns NIL, then we invalidate it (setting it to
+;;; (:FLUSH <wrapper>); UPDATE-SLOTS later gets to choose whether or
+;;; not to "upgrade" this to (:OBSOLETE <wrapper>).
+;;;
+;;; This leaves the case where LAYOUT-INVALID returns T, which happens
+;;; when REGISTER-LAYOUT has invalidated a superclass of CLASS (which
+;;; invalidated all the subclasses in SB-KERNEL land).  Again, here we
+;;; must flush the caches and allow UPDATE-SLOTS to decide whether to
+;;; obsolete the wrapper.
+;;;
+;;; FIXME: either here or in INVALID-WRAPPER-P looks like a good place
+;;; for (AVER (NOT (EQ (SB-KERNEL:LAYOUT-INVALID OWRAPPER)
+;;;                    :UNINITIALIZED)))
+;;;
+;;; Thanks to Gerd Moellmann for the explanation.  -- CSR, 2002-10-29
 (defun force-cache-flushes (class)
   (let* ((owrapper (class-wrapper class)))
     ;; We only need to do something if the wrapper is still valid. If
@@ -1056,10 +1075,10 @@
     ;; particular, we must be sure we never change an OBSOLETE into a
     ;; FLUSH since OBSOLETE means do what FLUSH does and then some.
     (when (or (not (invalid-wrapper-p owrapper))
-             ;; Ick. LAYOUT-INVALID can return a list (which we can
-             ;; handle), T (which we can't), NIL (which is handled by
-             ;; INVALID-WRAPPER-P) or :UNINITIALIZED (which never
-             ;; gets here (I hope).  -- CSR, 2002-10-28
+             ;; KLUDGE: despite the observations above, this remains
+             ;; a violation of locality or what might be considered
+             ;; good style.  There has to be a better way!  -- CSR,
+             ;; 2002-10-29
              (eq (sb-kernel:layout-invalid owrapper) t))
       (let ((nwrapper (make-wrapper (wrapper-no-of-instance-slots owrapper)
                                    class)))

diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index b08b1d9..b4462cd 100644 (file)
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -342,6 +342,30 @@
 (defclass c176-0 (b176) ())
 (assert (= 1 (setf (slot-value (make-instance 'c176-9) 'aslot-176) 1)))
 \f
+;;; DEFINE-METHOD-COMBINATION was over-eager at checking for duplicate
+;;; primary methods:
+(define-method-combination dmc-test-mc (&optional (order :most-specific-first))
+  ((around (:around))
+   (primary (dmc-test-mc) :order order :required t))
+   (let ((form (if (rest primary)
+                   `(and ,@(mapcar #'(lambda (method)
+                                       `(call-method ,method))
+                                   primary))
+                   `(call-method ,(first primary)))))
+     (if around
+         `(call-method ,(first around)
+                       (,@(rest around)
+                        (make-method ,form)))
+         form)))
+
+(defgeneric dmc-test-mc (&key k)
+  (:method-combination dmc-test-mc))
+
+(defmethod dmc-test-mc dmc-test-mc (&key k)
+          k)
+
+(dmc-test-mc :k 1)
+\f
 ;;;; success
 
 (sb-ext:quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index e697733..3ee10d7 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.7.9.13"
+"0.7.9.14"