X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdefcombin.lisp;h=897b6449c734f9f1214b23e5637eeb1f88dfe5ab;hb=d501bef3a93da4f14f1e85b852c2e01ee1df2907;hp=7975e13dfa2b330a8ff7bef781a241122db6ceef;hpb=a96eb725c8b9082a576d2ea51a42cdc31fde3ea0;p=sbcl.git

diff --git a/src/pcl/defcombin.lisp b/src/pcl/defcombin.lisp
index 7975e13..897b644 100644
--- a/src/pcl/defcombin.lisp
+++ b/src/pcl/defcombin.lisp
@@ -161,8 +161,29 @@
 		`(,operator ,@(mapcar (lambda (m) `(call-method ,m ()))
 				      primary)))))
       (cond ((null primary)
-	     `(error "No ~S methods for the generic function ~S."
-		     ',type ',generic-function))
+	     ;; FIXME(?): NO-APPLICABLE-METHOD seems more appropriate
+	     ;; here, but
+	     ;;   (1) discussion with CSR on #lisp reminded me that it's
+	     ;;       a vexed question whether we can validly call
+	     ;;       N-A-M when an :AROUND method exists (and the
+	     ;;       definition of NO-NEXT-METHOD seems to discourage
+	     ;;       us from calling NO-NEXT-METHOD directly in that
+	     ;;       case, since it's supposed to be called from a
+	     ;;       CALL-NEXT-METHOD form), and
+	     ;;   (2) a call to N-A-M would require &REST FUN-ARGS, and
+	     ;;       we don't seem to have FUN-ARGS here.
+	     ;; I think ideally failures in short method combination
+	     ;; would end up either in NO-APPLICABLE-METHOD or
+	     ;; NO-NEXT-METHOD, and I expect that's what ANSI
+	     ;; generally intended, but it's not clear to me whether
+	     ;; the details of what they actually specified let us
+	     ;; make that happen. So for now I've just tried to
+	     ;; clarify the error message text but left the general
+	     ;; logic alone (and raised the question on sbcl-devel).
+	     ;; -- WHN 2003-06-16
+	     `(error "no ~S methods for ~S on these arguments"
+		     ',type
+		     ',generic-function))
 	    ((null around) main-method)
 	    (t
 	     `(call-method ,(car around)
@@ -233,9 +254,7 @@
        (type ll method-group-specifiers args-option gf-var body)
   (declare (ignore type))
   (multiple-value-bind (real-body declarations documentation)
-      ;; (Note that PARSE-BODY ignores its second arg ENVIRONMENT.)
-      (parse-body body nil)
-
+      (parse-body body)
     (let ((wrapped-body
 	    (wrap-method-group-specifier-bindings method-group-specifiers
 						  declarations
@@ -385,8 +404,8 @@
     ;; name of a &WHOLE parameter, if any.
     (when (member '&whole (rest args-lambda-list))
       (error 'simple-program-error
-	     :format-control "~@<The value of the :ARGUMENTS option of~
-                DEFINE-METHOD-COMBINATION is~2I~_~S,~I~_but &WHOLE may~
+	     :format-control "~@<The value of the :ARGUMENTS option of ~
+                DEFINE-METHOD-COMBINATION is~2I~_~S,~I~_but &WHOLE may ~
                 only appear first in the lambda list.~:>"
 	     :format-arguments (list args-lambda-list)))
     (loop with state = 'required
@@ -472,4 +491,4 @@
 			 (t list))))
 	    (return (nconc (frob required nr nreq)
 			   (frob optional no nopt)
-			   values)))))
\ No newline at end of file
+			   values)))))