From 51af043f73c683c0609d4285a1bfee7d07e08b7a Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Mon, 9 Jul 2018 12:53:52 +0100
Subject: [PATCH] src/: Check that methods are compatible during class
 finalization.

This is the payoff from the previous refactoring.  Check, specifically,
that the keyword argument types among the applicable methods are
compatible.  Otherwise we only find out about this during effective-
method computation, which happens during output, and it's too late to
stop the presses.
---
 doc/SYMBOLS                  | 3 +++
 doc/layout.tex               | 4 ++++
 src/class-finalize-impl.lisp | 9 +++++++++
 src/method-impl.lisp         | 3 +++
 src/method-proto.lisp        | 9 +++++++++
 5 files changed, 28 insertions(+)

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 95604ae..63e0abc 100644
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -546,6 +546,7 @@ method-proto.lisp
   simple-method-body                            generic
   sod-message-applicable-methods                generic
   sod-message-argument-tail                     generic
+  sod-message-check-methods                     generic
   sod-message-effective-method-class            generic
   sod-message-keyword-argument-lists            generic
   sod-method-description                        generic
@@ -1517,6 +1518,8 @@ sod-message-applicable-methods
   sod-message sod-class
 sod-message-argument-tail
   basic-message
+sod-message-check-methods
+  sod-message sod-class t
 sod-message-class
   sod-message
 sod-message-combination
diff --git a/doc/layout.tex b/doc/layout.tex
index ca31a9c..95753b1 100644
--- a/doc/layout.tex
+++ b/doc/layout.tex
@@ -247,6 +247,10 @@
 \end{describe}
 
 \begin{describe}{gf}
+    {sod-message-check-methods @<message> @<class> @<direct-methods>}
+\end{describe}
+
+\begin{describe}{gf}
     {sod-message-effective-method-class @<message> @> @<class>}
 \end{describe}
 
diff --git a/src/class-finalize-impl.lisp b/src/class-finalize-impl.lisp
index 10d2b2f..2978bd4 100644
--- a/src/class-finalize-impl.lisp
+++ b/src/class-finalize-impl.lisp
@@ -516,6 +516,15 @@
 				 has metaclass `~A'"
 				super supermeta))))))
 
+  ;; Check that all of the messages we can be sent have coherent collections
+  ;; of applicable methods.  This can go wrong, for example, if we inherit
+  ;; methods with differently typed keyword arguments.
+  (finalization-error (:mismatched-applicable-methods)
+    (dolist (super (sod-class-precedence-list class))
+      (dolist (message (sod-class-messages super))
+	(let ((methods (sod-message-applicable-methods message class)))
+	  (sod-message-check-methods message class methods)))))
+
   ;; Check that an initializer is available for every slot in the class's
   ;; metaclass.  Skip this and trust the caller if the metaclass isn't
   ;; finalized yet: in that case, we must be bootstrapping, and we must hope
diff --git a/src/method-impl.lisp b/src/method-impl.lisp
index 91c22bb..6c751a4 100644
--- a/src/method-impl.lisp
+++ b/src/method-impl.lisp
@@ -272,6 +272,9 @@
 			     (c-function-keywords (sod-method-type method))))
 		     direct-methods))))
 
+(defmethod sod-message-check-methods
+    ((message sod-message) (class sod-class) direct-methods)
+  (compute-effective-method-keyword-arguments message class direct-methods))
 
 (defmethod shared-initialize :after
     ((method effective-method) slot-names &key direct-methods)
diff --git a/src/method-proto.lisp b/src/method-proto.lisp
index 1298431..5687802 100644
--- a/src/method-proto.lisp
+++ b/src/method-proto.lisp
@@ -95,6 +95,15 @@
 							     direct-methods
 							     state))))
 
+(export 'sod-message-check-methods)
+(defgeneric sod-message-check-methods (message class direct-methods)
+  (:documentation
+   "Check that the applicable methods for a MESSAGE are compatible.
+
+   Specifically, given the DIRECT-METHODS applicable for the message when
+   received by an instance of CLASS, signal errors if the methods don't
+   match the MESSAGE or each other."))
+
 (export 'sod-message-effective-method-class)
 (defgeneric sod-message-effective-method-class (message)
   (:documentation
-- 
2.11.0