From b570ee9f55413605bd79dcf1108476417d65b3e4 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Fri, 7 Mar 2014 14:33:18 -0500
Subject: [PATCH] plan changes: * move *all* timestamp management to
 COMPUTE-ACTION-STAMP. * goodbye visit-dependencies, move its functionality to
 map-direct-dependencies, * refactored map-direct-dependencies and co to
 always take a plan object. * modified clients of map-direct-dependencies and
 co to pass a proper plan, or t. Add invalid file with false if-feature to
 bundle.

---
 bundle.lisp        |  8 +++----
 plan.lisp          | 57 +++++++++++++++++++++-------------------------
 test/test-asdf.asd |  4 +++-
 upgrade.lisp       |  1 +
 4 files changed, 34 insertions(+), 36 deletions(-)

diff --git a/bundle.lisp b/bundle.lisp
index 68d7bd05..fe020bf3 100644
--- a/bundle.lisp
+++ b/bundle.lisp
@@ -240,9 +240,9 @@ itself.")) ;; operation on a system and its dependencies
     ;; your component-depends-on method better gathered the correct dependencies in the correct order.
     (while-collecting (collect)
       (map-direct-dependencies
-       o c #'(lambda (sub-o sub-c)
-               (loop :for f :in (funcall key sub-o sub-c)
-                     :when (funcall test f) :do (collect f))))))
+       t o c #'(lambda (sub-o sub-c)
+                 (loop :for f :in (funcall key sub-o sub-c)
+                       :when (funcall test f) :do (collect f))))))
 
   (defmethod input-files ((o gather-op) (c system))
     (unless (eq (bundle-type o) :no-output-file)
@@ -368,7 +368,7 @@ itself.")) ;; operation on a system and its dependencies
                                                        :keep-operation 'load-op))
                  (while-collecting (x) ;; resolve the sideway-dependencies of s
                    (map-direct-dependencies
-                    'load-op s
+                    t 'load-op s
                     #'(lambda (o c)
                         (when (and (typep o 'load-op) (typep c 'system))
                           (x c)))))))
diff --git a/plan.lisp b/plan.lisp
index df88e3af..e7939498 100644
--- a/plan.lisp
+++ b/plan.lisp
@@ -9,7 +9,7 @@
    :asdf/operation :asdf/action :asdf/lisp-action)
   (:export
    #:component-operation-time #:mark-operation-done
-   #:plan-traversal #:sequential-plan #:*default-plan-class*
+   #:plan #:plan-traversal #:sequential-plan #:*default-plan-class*
    #:planned-action-status #:plan-action-status #:action-already-done-p
    #:circular-dependency #:circular-dependency-actions
    #:node-for #:needed-in-image-p
@@ -17,7 +17,7 @@
    #:plan-record-dependency
    #:normalize-forced-systems #:action-forced-p #:action-forced-not-p
    #:map-direct-dependencies #:reduce-direct-dependencies #:direct-dependencies
-   #:visit-dependencies #:compute-action-stamp #:traverse-action
+   #:compute-action-stamp #:traverse-action
    #:circular-dependency #:circular-dependency-actions
    #:call-while-visiting-action #:while-visiting-action
    #:make-plan #:plan-actions #:perform-plan #:plan-operates-on-p
@@ -32,7 +32,8 @@
 
 ;;;; Generic plan traversal class
 (with-upgradability ()
-  (defclass plan-traversal ()
+  (defclass plan () ())
+  (defclass plan-traversal (plan)
     ((system :initform nil :initarg :system :accessor plan-system)
      (forced :initform nil :initarg :force :accessor plan-forced)
      (forced-not :initform nil :initarg :force-not :accessor plan-forced-not)
@@ -146,13 +147,12 @@ the action of OPERATION on COMPONENT in the PLAN"))
 (with-upgradability ()
   (defgeneric action-valid-p (plan operation component)
     (:documentation "Is this action valid to include amongst dependencies?"))
-  (defmethod action-valid-p ((plan plan-traversal) (o operation) (c component))
+  (defmethod action-valid-p ((plan t) (o operation) (c component))
     (if-let (it (component-if-feature c)) (featurep it) t))
   (defmethod action-valid-p ((plan t) (o null) (c t)) nil)
   (defmethod action-valid-p ((plan t) (o t) (c null)) nil)
   (defmethod action-valid-p ((plan null) (o operation) (c component)) t))
 
-
 ;;;; Is the action needed in this image?
 (with-upgradability ()
   (defgeneric needed-in-image-p (operation component)
@@ -169,38 +169,30 @@ the action of OPERATION on COMPONENT in the PLAN"))
 
 ;;;; Visiting dependencies of an action and computing action stamps
 (with-upgradability ()
-  (defun map-direct-dependencies (operation component fun)
+  (defun (map-direct-dependencies) (plan operation component fun)
     (loop* :for (dep-o-spec . dep-c-specs) :in (component-depends-on operation component)
            :for dep-o = (find-operation operation dep-o-spec)
            :when dep-o
            :do (loop :for dep-c-spec :in dep-c-specs
                      :for dep-c = (and dep-c-spec (resolve-dependency-spec component dep-c-spec))
-                     :when dep-c
+                     :when (and dep-c (action-valid-p plan dep-o dep-c))
                        :do (funcall fun dep-o dep-c))))
 
-  (defun reduce-direct-dependencies (operation component combinator seed)
+  (defun (reduce-direct-dependencies) (plan operation component combinator seed)
     (map-direct-dependencies
-     operation component
+     plan operation component
      #'(lambda (dep-o dep-c)
          (setf seed (funcall combinator dep-o dep-c seed))))
     seed)
 
-  (defun direct-dependencies (operation component)
-    (reduce-direct-dependencies operation component #'acons nil))
+  (defun (direct-dependencies) (plan operation component)
+    (reduce-direct-dependencies plan operation component #'acons nil))
 
   ;; In a distant future, get-file-stamp, component-operation-time and latest-stamp
   ;; shall also be parametrized by the plan, or by a second model object,
   ;; so they need not refer to the state of the filesystem,
   ;; and the stamps could be cryptographic checksums rather than timestamps.
-  ;; Such a change remarkably would only affect VISIT-DEPENDENCIES and COMPUTE-ACTION-STAMP.
-
-  (defun visit-dependencies (plan operation component dependency-stamper &aux stamp)
-    (map-direct-dependencies
-     operation component
-     #'(lambda (dep-o dep-c)
-         (when (action-valid-p plan dep-o dep-c)
-           (latest-stamp-f stamp (funcall dependency-stamper dep-o dep-c)))))
-    stamp)
+  ;; Such a change remarkably would only affect COMPUTE-ACTION-STAMP.
 
   (defmethod compute-action-stamp (plan (o operation) (c component) &key just-done)
     ;; Given an action, figure out at what time in the past it has been done,
@@ -216,10 +208,13 @@ the action of OPERATION on COMPONENT in the PLAN"))
     (nest
      (block ())
      (let ((dep-stamp ; collect timestamp from dependencies (or T if forced or out-of-date)
-             (visit-dependencies plan o c #'(lambda (o c)
-                                              (if-let (it (plan-action-status plan o c))
-                                                (action-stamp it)
-                                                t)))))
+             (reduce-direct-dependencies
+              plan o c
+              #'(lambda (o c stamp)
+                  (if-let (it (plan-action-status plan o c))
+                    (latest-stamp stamp (action-stamp it))
+                    t))
+              nil)))
        ;; out-of-date dependency: don't bother expensively querying the filesystem
        (when (and (eq dep-stamp t) (not just-done)) (return (values t nil))))
      ;; collect timestamps from inputs, and exit early if any is missing
@@ -352,8 +347,8 @@ the action of OPERATION on COMPONENT in the PLAN"))
         (when (and status (or (action-done-p status) (action-planned-p status) (not eniip)))
           (return (action-stamp status))) ; Already visited with sufficient need-in-image level!
         (labels ((visit-action (niip) ; We may visit the action twice, once with niip NIL, then T
-                   (visit-dependencies plan operation component ; recursively traverse dependencies
-                                       #'(lambda (o c) (traverse-action plan o c niip)))
+                   (map-direct-dependencies ; recursively traverse dependencies
+                    plan operation component #'(lambda (o c) (traverse-action plan o c niip)))
                    (multiple-value-bind (stamp done-p) ; AFTER dependencies have been traversed,
                        (compute-action-stamp plan operation component) ; compute action stamp
                      (let ((add-to-plan-p (or (eql stamp t) (and niip (not done-p)))))
@@ -398,7 +393,7 @@ the action of OPERATION on COMPONENT in the PLAN"))
     (when (action-planned-p new-status)
       (push (cons o c) (plan-actions-r p)))))
 
-;;;; high-level interface: traverse, perform-plan, plan-operates-on-p
+;;;; High-level interface: traverse, perform-plan, plan-operates-on-p
 (with-upgradability ()
   (defgeneric make-plan (plan-class operation component &key &allow-other-keys)
     (:documentation
@@ -411,8 +406,7 @@ the action of OPERATION on COMPONENT in the PLAN"))
   (defvar *default-plan-class* 'sequential-plan)
 
   (defmethod make-plan (plan-class (o operation) (c component) &rest keys &key &allow-other-keys)
-    (let ((plan (apply 'make-instance
-                       (or plan-class *default-plan-class*)
+    (let ((plan (apply 'make-instance (or plan-class *default-plan-class*)
                        :system (component-system c) keys)))
       (traverse-action plan o c t)
       plan))
@@ -471,8 +465,9 @@ the action of OPERATION on COMPONENT in the PLAN"))
       plan))
 
   (define-convenience-action-methods traverse-sub-actions (operation component &key))
-  (defmethod traverse-sub-actions ((operation operation) (component component) &rest keys &key &allow-other-keys)
-    (apply 'traverse-actions (direct-dependencies operation component)
+  (defmethod traverse-sub-actions ((operation operation) (component component)
+                                   &rest keys &key &allow-other-keys)
+    (apply 'traverse-actions (direct-dependencies t operation component)
            :system (component-system component) keys))
 
   (defmethod plan-actions ((plan filtered-sequential-plan))
diff --git a/test/test-asdf.asd b/test/test-asdf.asd
index 331e2edf..027002ba 100644
--- a/test/test-asdf.asd
+++ b/test/test-asdf.asd
@@ -66,7 +66,9 @@
   :components ((:file "file1") (:file "file3")))
 
 (defsystem :test-asdf/bundle-2
-  :depends-on (:test-asdf/bundle-1) :components ((:file "file2")))
+  :depends-on (:test-asdf/bundle-1) :components
+  ((:file "file2")
+   (:file "invalid-file" :if-feature (:not :common-lisp))))
 
 (defsystem :test-asdf/force
   :depends-on (:test-asdf/force1)
diff --git a/upgrade.lisp b/upgrade.lisp
index fa8e578b..52792f37 100644
--- a/upgrade.lisp
+++ b/upgrade.lisp
@@ -89,6 +89,7 @@ previously-loaded version of ASDF."
 	    #:explain #:perform #:perform-with-restarts #:input-files #:output-files ;; action
 	    #:component-depends-on #:operation-done-p #:component-depends-on
 	    #:traverse ;; backward-interface
+            #:map-direct-dependencies #:reduce-direct-dependencies #:direct-dependencies ;; plan
 	    #:operate  ;; operate
 	    #:parse-component-form ;; defsystem
 	    #:apply-output-translations ;; output-translations
-- 
GitLab