Changeset 11600


Ignore:
Timestamp:
Jan 8, 2009, 4:09:52 PM (11 years ago)
Author:
gz
Message:

Propagate r11598 to trunk

Location:
trunk/source
Files:
3 edited

Legend:

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

    r11514 r11600  
    533533      (report-deferred-warnings))))
    534534
    535 (defun %defer-warnings (override &optional flags &aux (parent *outstanding-deferred-warnings*))
     535(defun %defer-warnings (override &aux (parent *outstanding-deferred-warnings*))
     536  (when parent
     537    (ensure-merged-deferred-warnings parent))
    536538  (%istruct 'deferred-warnings
    537539            (unless override parent)
    538540            nil
    539541            (make-hash-table :test #'eq)
    540             flags))
    541 
    542 (defun report-deferred-warnings ()
    543   (let* ((current *outstanding-deferred-warnings*)
     542            nil))
     543
     544(defun ensure-merged-deferred-warnings (parent &aux (last (deferred-warnings.last-file parent)))
     545  (when last
     546    (setf (deferred-warnings.last-file parent) nil)
     547    (let* ((child (car last)) ;; last = (deferred-warnings . file)
     548           (warnings (deferred-warnings.warnings child))
     549           (defs (deferred-warnings.defs child))
     550           (parent-defs (deferred-warnings.defs parent))
     551           (parent-warnings (deferred-warnings.warnings parent)))
     552      (maphash (lambda (key val) (setf (gethash key parent-defs) val)) defs)
     553      (setf (deferred-warnings.warnings parent) (append warnings parent-warnings))))
     554  parent)
     555
     556
     557(defun report-deferred-warnings (&optional (file nil))
     558  (let* ((current (ensure-merged-deferred-warnings *outstanding-deferred-warnings*))
    544559         (parent (deferred-warnings.parent current))
    545560         (warnings (deferred-warnings.warnings current))
     
    548563         (harsh nil))
    549564    (if parent
    550       (let ((parent-defs (deferred-warnings.defs parent))
    551             (parent-warnings (deferred-warnings.warnings parent)))
    552         (maphash (lambda (key val) (setf (gethash key parent-defs) val)) defs)
    553         (setf (deferred-warnings.warnings parent) (append warnings parent-warnings)
    554               parent t))
     565      (progn
     566        (setf (deferred-warnings.last-file parent) (cons current file))
     567        (unless file ;; don't defer merge for non-file units.
     568          (ensure-merged-deferred-warnings parent))
     569        (setq parent t))
    555570      (let* ((file nil)
    556571             (init t))
  • trunk/source/lib/nfcomp.lisp

    r11572 r11600  
    4444(require "X8664-ARCH")
    4545) ;eval-when (:compile-toplevel :execute)
     46
     47;; Temp, for loading into a lisp that doesn't have the report-deferred-warnings change
     48;; in level-1 yet.
     49#-BOOTSTRAPPED (when (eql 0 (ldb $lfbits-numopt (lfun-bits #'report-deferred-warnings)))
     50                 (%fhave 'report-deferred-warnings (lambda (&optional x) x nil)))
    4651
    4752
     
    220225             (*fcomp-external-format* external-format)
    221226             (forms nil))
     227      (let ((current *outstanding-deferred-warnings*) last)
     228        (when (and current
     229                   (setq last (deferred-warnings.last-file current))
     230                   (equalp *compile-file-pathname* (cdr last)))
     231          ;; Discard previous deferred warnings when recompiling exactly the same file again,
     232          ;; since most likely this is due to an interactive "retry compilation" request and
     233          ;; we want to avoid duplicate warnings.
     234          (setf (deferred-warnings.last-file current) nil)))
     235
    222236      (let* ((*outstanding-deferred-warnings* (%defer-warnings nil)))
    223237        (rplacd (defenv.type defenv) *outstanding-deferred-warnings*)
     
    232246              (append *fasl-deferred-warnings* (deferred-warnings.warnings *outstanding-deferred-warnings*)))
    233247        (when *compile-verbose* (fresh-line))
    234         (multiple-value-bind (any harsh) (report-deferred-warnings)
     248        (multiple-value-bind (any harsh) (report-deferred-warnings *compile-file-pathname*)
    235249          (setq *fasl-warnings-signalled-p* (or *fasl-warnings-signalled-p* any)
    236250                *fasl-non-style-warnings-signalled-p* (if (eq harsh :very) :very
  • trunk/source/library/lispequ.lisp

    r11361 r11600  
    15721572  deferred-warnings.warnings
    15731573  deferred-warnings.defs
    1574   deferred-warnings.flags ; might use to distinguish interactive case/compile-file
     1574  deferred-warnings.last-file
    15751575)
    15761576
Note: See TracChangeset for help on using the changeset viewer.