Changeset 11600 for trunk/source/level-1


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

Propagate r11598 to trunk

File:
1 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))
Note: See TracChangeset for help on using the changeset viewer.