Changeset 8782


Ignore:
Timestamp:
Mar 14, 2008, 11:15:26 AM (12 years ago)
Author:
gb
Message:

When REPORT-DEFERRED-WARNINGS finds a forward-referenced function,
check to see if the caller's args match.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/level-1/sysutils.lisp

    r8769 r8782  
    554554             (init t))
    555555        (dolist (w warnings)
    556           (let ((wfname (car (compiler-warning-args w))))
     556          (let* ((args (compiler-warning-args w))
     557                 (wfname (car args))
     558                (def nil))
    557559            (when (if (typep w 'undefined-function-reference)
    558                     (not (or (fboundp wfname)
    559                              (assq wfname defs))))
     560                    (not (setq def (or (fboundp wfname)
     561                                       (assq wfname defs)))))
    560562              (multiple-value-setq (harsh any file) (signal-compiler-warning w init file harsh any))
    561               (setq init nil))))))
     563              (setq init nil))
     564            ;; Check args in call to forward-referenenced function.
     565            (when (and def (cdr args))
     566              (destructuring-bind (arglist spread-p)
     567                  (cdr args)
     568                (multiple-value-bind (deftype reason)
     569                    (nx1-check-call-args def arglist spread-p)
     570                  (when deftype
     571                    (let* ((w2 (make-condition
     572                                'invalid-arguments
     573                                :file-name (compiler-warning-file-name w)
     574                                :function-name (compiler-warning-function-name w)
     575                                :warning-type deftype
     576                                :args (list (car args) reason arglist spread-p))))
     577                      (setf (compiler-warning-stream-position w2)
     578                            (compiler-warning-stream-position w))
     579
     580                    (multiple-value-setq (harsh any file)
     581                      (signal-compiler-warning w2 init file harsh any))
     582                    (setq init nil))))))))))
    562583    (values any harsh parent)))
    563584
Note: See TracChangeset for help on using the changeset viewer.