Changeset 8779


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

MERGE-COMPILER-WARNINGS: don't merge if there's info in CDR of
ARGS slot.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/compiler/nx-basic.lisp

    r8766 r8779  
    406406  (%make-function nil lambda-expression env))
    407407
    408 #| Might be nicer to do %declaim
     408#|| Might be nicer to do %declaim
    409409(defmacro declaim (&rest decl-specs &environment env)
    410410  `(progn
     
    413413     (eval-when (:compile-toplevel)
    414414       (%declaim ',@decl-specs ,env))))
    415 |#
     415||#
    416416
    417417(defmacro declaim (&environment env &rest decl-specs)
     
    425425       ,@body))))
    426426
     427;;; If warnings have more than a single entry on their
     428;;; args slot, don't merge them.
    427429(defun merge-compiler-warnings (old-warnings)
    428430  (let ((warnings nil))
    429431    (dolist (w old-warnings)
    430       (if
    431         (dolist (w1 warnings t)
    432           (let ((w1-args (compiler-warning-args w1)))
    433             (when (and (eq (compiler-warning-warning-type w)
    434                            (compiler-warning-warning-type w1))
    435                        w1-args
    436                        (eq (%car (compiler-warning-args w))
    437                            (%car w1-args)))
    438               (incf (compiler-warning-nrefs w1))
    439               (return))))
    440          (push w warnings)))
     432      (let* ((w-args (compiler-warning-args w)))
     433        (if
     434          (or (cdr w-args)
     435              (dolist (w1 warnings t)
     436                (let ((w1-args (compiler-warning-args w1)))
     437                  (when (and (eq (compiler-warning-warning-type w)
     438                                 (compiler-warning-warning-type w1))
     439                             w1-args
     440                             (null (cdr w1-args))
     441                             (eq (%car w-args)
     442                                 (%car w1-args)))
     443                    (incf (compiler-warning-nrefs w1))
     444                    (return)))))
     445          (push w warnings))))
    441446    warnings))
    442447
     
    459464  (destructuring-bind (callee reason args spread-p)
    460465      (compiler-warning-args condition)
    461     (format stream "In the ~a ~s with arguments ~:s,~%  "
    462             (if spread-p "application of" "call to")
     466    (format stream "In ~a ~s with arguments ~:s,~%  "
     467            (if spread-p "an application of" "a call to")
    463468            callee
    464469            args)
Note: See TracChangeset for help on using the changeset viewer.