diff options
| author | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-02-21 20:35:06 +0100 |
|---|---|---|
| committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-02-21 20:35:06 +0100 |
| commit | 7f73b91fcc4afea1170feb20327615d63431cc6f (patch) | |
| tree | 39c84d393486cfce4495dfec672bc39be24560f6 /protocols.lisp | |
| parent | b67cbad14d925e35870f5aae8f42efac2ad1733f (diff) | |
Warn about indeterminable method implementation.
darcs-hash:1249fc4685bb4b81fcd56d029935fb8c7b8e8587
Diffstat (limited to 'protocols.lisp')
| -rw-r--r-- | protocols.lisp | 26 |
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 |