X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdefcombin.lisp;h=c4dc44981d0e36f208ef310bc5b3d4a95f4115f0;hb=b83353d9f998e5c0e34604b5593df70c66d2c510;hp=4edc8bd2f45808885b7a92e621fb449a0109b408;hpb=ba2010734297dc7e9b06b1199afc5bc806b50dfc;p=sbcl.git

diff --git a/src/pcl/defcombin.lisp b/src/pcl/defcombin.lisp
index 4edc8bd..c4dc449 100644
--- a/src/pcl/defcombin.lisp
+++ b/src/pcl/defcombin.lisp
@@ -324,7 +324,12 @@
     (method-group-specifiers declarations real-body)
   (let (names specializer-caches cond-clauses required-checks order-cleanups)
     (let ((nspecifiers (length method-group-specifiers)))
-      (dolist (method-group-specifier method-group-specifiers)
+      (dolist (method-group-specifier method-group-specifiers
+               (push `(t (return-from .long-method-combination-function.
+                           `(invalid-method-error , .method.
+                             "~@<is applicable, but does not belong ~
+                              to any method group~@:>")))
+                     cond-clauses))
         (multiple-value-bind (name tests description order required)
             (parse-method-group-specifier method-group-specifier)
           (declare (ignore description))
@@ -343,7 +348,8 @@
                           :format-arguments (list ',name))))
                     required-checks))
             (loop (unless (and (constantp order)
-                               (neq order (setq order (eval order))))
+                               (neq order (setq order
+                                                (constant-form-value order))))
                     (return t)))
             (push (cond ((eq order :most-specific-first)
                          `(setq ,name (nreverse ,name)))
@@ -431,7 +437,7 @@
   (let ((intercept-rebindings
          (let (rebindings)
            (dolist (arg args-lambda-list (nreverse rebindings))
-             (unless (member arg lambda-list-keywords)
+             (unless (member arg lambda-list-keywords :test #'eq)
                (typecase arg
                  (symbol (push `(,arg ',arg) rebindings))
                  (cons