[Sbcl-commits] CVS: sbcl/src/pcl defcombin.lisp,1.13,1.14 std-class.lisp,1.30,1.31

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/pcl
In directory usw-pr-cvs1:/tmp/cvs-serv12175/src/pcl

Modified Files:
	defcombin.lisp std-class.lisp 
Log Message:
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


Index: defcombin.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/defcombin.lisp,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- defcombin.lisp	28 Oct 2002 14:33:31 -0000	1.13
+++ defcombin.lisp	30 Oct 2002 12:25:49 -0000	1.14
@@ -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)

Index: std-class.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/std-class.lisp,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -d -r1.30 -r1.31
--- std-class.lisp	29 Oct 2002 12:48:21 -0000	1.30
+++ std-class.lisp	30 Oct 2002 12:25:49 -0000	1.31
@@ -1048,6 +1048,25 @@
     (or (eq new-super-meta-class *the-class-std-class*)
 	(eq (class-of class) new-super-meta-class))))
 
+;;; 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)))