X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fcombin.lisp;h=a28a1e4bfb41d654e1a3b2a6ed60c9137603d182;hb=8dc064d2296902f01afd9107e89a81146e3771fe;hp=1c600ff589a0c7c44693e54576b77b5a04010750;hpb=2c6b90e36a7c0377cd79625eb6c94d580f98cb93;p=sbcl.git

diff --git a/src/pcl/combin.lisp b/src/pcl/combin.lisp
index 1c600ff..a28a1e4 100644
--- a/src/pcl/combin.lisp
+++ b/src/pcl/combin.lisp
@@ -306,15 +306,30 @@
 	(primary ())
 	(after ())
 	(around ()))
-    (dolist (m applicable-methods)
-      (let ((qualifiers (if (listp m)
-			    (early-method-qualifiers m)
-			    (method-qualifiers m))))
-	(cond ((member ':before qualifiers)  (push m before))
-	      ((member ':after  qualifiers)  (push m after))
-	      ((member ':around  qualifiers) (push m around))
-	      (t
-	       (push m primary)))))
+    (flet ((lose (method why)
+             (invalid-method-error
+              method
+              "The method ~S ~A.~%~
+               Standard method combination requires all methods to have one~%~
+               of the single qualifiers :AROUND, :BEFORE and :AFTER or to~%~
+               have no qualifier at all."
+              method why)))
+      (dolist (m applicable-methods)
+        (let ((qualifiers (if (listp m)
+                            (early-method-qualifiers m)
+                            (method-qualifiers m))))
+          (cond
+            ((null qualifiers) (push m primary))
+            ((cdr qualifiers)
+              (lose m "has more than one qualifier"))
+            ((eq (car qualifiers) :around)
+              (push m around))
+            ((eq (car qualifiers) :before)
+              (push m before))
+            ((eq (car qualifiers) :after)
+              (push m after))
+            (t
+              (lose m "has an illegal qualifier"))))))
     (setq before  (reverse before)
 	  after   (reverse after)
 	  primary (reverse primary)
@@ -359,7 +374,7 @@
 				     applicable-methods))
 
 (defun invalid-method-error (method format-control &rest format-arguments)
-  (error "~@<invalid method error for ~2I_~S ~I~_method: ~2I~_~?~:>"
+  (error "~@<invalid method error for ~2I~_~S ~I~_method: ~2I~_~?~:>"
 	 method
 	 format-control
 	 format-arguments))