Ignore:
Timestamp:
Oct 9, 2009, 2:46:02 PM (10 years ago)
Author:
gz
Message:

From working-0711 branch: more extensive compile-time checking involving methods/gfs: warn about incongruent lambda lists, duplicate gf defs, required keyword args (from defgeneric), and invalid keyword args in gf calls. Also fix to keep method source files in env function info so dup method warnings can cite the right file.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/sysutils.lisp

    r12500 r12940  
    563563    (undefined-type-reference (verify-deferred-type-warning w))
    564564    (undefined-function-reference (verify-deferred-function-warning w))
     565    (undefined-keyword-reference (verify-deferred-keyword-warning w))
    565566    (compiler-warning nil)))
    566567
     
    595596
    596597
     598(defun deferred-function-def (name)
     599  (let* ((defs (deferred-warnings.defs *outstanding-deferred-warnings*))
     600         (def (or (let ((cell (gethash name defs)))
     601                    (and cell (def-info.function-p (cdr cell)) cell))
     602                 (let* ((global (fboundp name)))
     603                   (and (typep global 'function) global)))))
     604    def))
     605
     606(defun check-deferred-call-args (w def wargs)
     607  (destructuring-bind (arglist spread-p) wargs
     608    (multiple-value-bind (deftype reason) (nx1-check-call-args def arglist spread-p)
     609      (when deftype
     610        (when (eq deftype :deferred-mismatch)
     611          (setq deftype (if (consp def) :environment-mismatch :global-mismatch)))
     612        (make-condition
     613         'invalid-arguments
     614         :function-name (compiler-warning-function-name w)
     615         :source-note (compiler-warning-source-note w)
     616         :warning-type deftype
     617         :args (list (car (compiler-warning-args w)) reason arglist spread-p))))))
     618
    597619(defun verify-deferred-function-warning (w)
    598620  (let* ((args (compiler-warning-args w))
    599621         (wfname (car args))
    600          (defs (deferred-warnings.defs *outstanding-deferred-warnings*))
    601          (def (or (let ((cell (gethash wfname defs)))
    602                    (and cell (def-info.function-p (cdr cell)) cell))
    603                  (let* ((global (fboundp wfname)))
    604                    (and (typep global 'function) global)))))
     622         (def (deferred-function-def wfname)))
    605623    (cond ((null def) w)
    606624          ((or (typep def 'function)
     
    609627           ;; Check args in call to forward-referenced function.
    610628           (when (cdr args)
    611              (destructuring-bind (arglist spread-p) (cdr args)
    612                (multiple-value-bind (deftype reason)
    613                    (nx1-check-call-args def arglist spread-p)
    614                  (when deftype
    615                    (let* ((w2 (make-condition
    616                                'invalid-arguments
    617                                :function-name (compiler-warning-function-name w)
    618                                :source-note (compiler-warning-source-note w)
    619                                :warning-type deftype
    620                                :args (list (car args) reason arglist spread-p))))
    621                      w2))))))
     629             (check-deferred-call-args w def (cdr args))))
    622630          ((def-info.macro-p (cdr def))
    623631           (let* ((w2 (make-condition
     
    628636                       :args (list (car args)))))
    629637             w2)))))
     638
     639(defun verify-deferred-keyword-warning (w)
     640  (let* ((args (compiler-warning-args w))
     641         (wfname (car args))
     642         (def (deferred-function-def wfname)))
     643    (when def
     644      (check-deferred-call-args w def (cddr args)))))
    630645
    631646
Note: See TracChangeset for help on using the changeset viewer.