summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-02-21 20:35:06 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-02-21 20:35:06 +0100
commit7f73b91fcc4afea1170feb20327615d63431cc6f (patch)
tree39c84d393486cfce4495dfec672bc39be24560f6
parentb67cbad14d925e35870f5aae8f42efac2ad1733f (diff)
Warn about indeterminable method implementation.
darcs-hash:1249fc4685bb4b81fcd56d029935fb8c7b8e8587
-rw-r--r--protocols.lisp26
1 files changed, 21 insertions, 5 deletions
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