From 7f73b91fcc4afea1170feb20327615d63431cc6f Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Thu, 21 Feb 2008 20:35:06 +0100 Subject: Warn about indeterminable method implementation. darcs-hash:1249fc4685bb4b81fcd56d029935fb8c7b8e8587 --- protocols.lisp | 26 +++++++++++++++++++++----- 1 file changed, 21 insertions(+), 5 deletions(-) (limited to 'protocols.lisp') diff --git a/protocols.lisp b/protocols.lisp index 0634847..072a0f2 100644 --- a/protocols.lisp +++ b/protocols.lisp @@ -106,19 +106,35 @@ methods ::= ((method-name [\\* | class-name]\\*)\\*)" raw-argument-class-list) for real-argument-class-list = (mapcar #'find-class argument-class-list) - when (null (funcall #'compute-applicable-methods-using-classes - (fdefinition name) - real-argument-class-list)) + for (applicable-methods methods-determinable-p) = + (multiple-value-list + (funcall #'compute-applicable-methods-using-classes + (fdefinition name) + real-argument-class-list)) + when (and methods-determinable-p (null applicable-methods)) collect method into missing-methods and do (warn (make-condition 'simple-style-warning - :format-control "Class ~A does not implement ~ - method ~A with argument types ~ + :format-control "Class ~A does not ~ + implement method ~A ~ + with argument types ~ ~A as required by ~ protocol ~A." :format-arguments (list class-name (first method) real-argument-class-list (protocol-name protocol)))) + unless methods-determinable-p + do (warn (make-condition 'simple-style-warning + :format-control "Could not check whether ~ + class ~A implements ~ + method ~A with argument ~ + types ~A as required by ~ + protocol ~A. Assuming it ~ + does." + :format-arguments (list class-name + (first method) + real-argument-class-list + (protocol-name protocol)))) finally (setq conforming-p (null missing-methods))) (let ((really-conforming-p (and conforming-p -- cgit v1.2.3