From 2dcd42a2bf85e36ddf539cb91ab35ca8b67f5d2b Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Thu, 3 Jan 2013 00:36:05 -0500
Subject: [PATCH] 2.26.50: preserve timestamps for forced-not actions.

Also, remove previously commented-out utilities from exported symbols.
Reinstate action-already-done-p for the sake of POIU.
---
 asdf.asd  |  2 +-
 asdf.lisp | 86 ++++++++++++++++++++-----------------------------------
 2 files changed, 32 insertions(+), 56 deletions(-)

diff --git a/asdf.asd b/asdf.asd
index dcedcc7a..034caf54 100644
--- a/asdf.asd
+++ b/asdf.asd
@@ -14,7 +14,7 @@
   :licence "MIT"
   :description "Another System Definition Facility"
   :long-description "ASDF builds Common Lisp software organized into defined systems."
-  :version "2.26.49" ;; to be automatically updated by bin/bump-revision
+  :version "2.26.50" ;; to be automatically updated by bin/bump-revision
   :depends-on ()
   :components
   ((:file "asdf")))
diff --git a/asdf.lisp b/asdf.lisp
index fddcd9a9..30112702 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -1,5 +1,5 @@
 ;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
-;;; This is ASDF 2.26.49: Another System Definition Facility.
+;;; This is ASDF 2.26.50: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
 ;;; please mail to <asdf-devel@common-lisp.net>.
@@ -120,7 +120,7 @@
          ;; "2.345.6" would be a development version in the official upstream
          ;; "2.345.0.7" would be your seventh local modification of official release 2.345
          ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
-         (asdf-version "2.26.49")
+         (asdf-version "2.26.50")
          (existing-asdf (find-class 'component nil))
          (existing-version *asdf-version*)
          (already-there (equal asdf-version existing-version)))
@@ -191,10 +191,14 @@
                  (unless (eq sym (find-symbol* sym package))
                    (remove-symbol sym package)))
                (use-package used package)))
-           (ensure-fmakunbound (package symbols)
-             (loop :for name :in symbols
-               :for sym = (find-symbol* name package)
-               :when sym :do (fmakunbound sym)))
+           #-ecl (ensure-fmakunbound (package symbols)
+                   (loop :for name :in symbols
+                         :for sym = (find-symbol* name package)
+                         :when sym :do (fmakunbound sym)))
+           #-ecl (ensure-fmakunbound-setf (package symbols)
+                   (loop :for name :in symbols
+                         :for sym = (find-symbol* name package)
+                         :when sym :do #-gcl (fmakunbound `(setf ,sym))))
            (ensure-export (package export)
              (let ((formerly-exported-symbols nil)
                    (bothly-exported-symbols nil)
@@ -215,25 +219,25 @@
                (loop :for x :in newly-exported-symbols :do
                  (export (intern* x package)))))
            (ensure-package (name &key nicknames use unintern
-                                 shadow export fmakunbound)
+                                 shadow export fmakunbound fmakunbound-setf)
              (let* ((p (ensure-exists name nicknames use)))
                #-ecl (ensure-fmakunbound p fmakunbound) #+ecl fmakunbound ;; do it later on ECL
+               #-ecl (ensure-fmakunbound-setf p fmakunbound-setf) #+ecl fmakunbound-setf
                (ensure-unintern p unintern)
                (ensure-shadow p shadow)
                (ensure-export p export)
                p)))
         (macrolet
             ((pkgdcl (name &key nicknames use export
-                           redefined-functions unintern shadow)
+                           fmakunbound fmakunbound-setf unintern shadow)
                  `(ensure-package
                    ',name :nicknames ',nicknames :use ',use :export ',export
-                   :shadow ',shadow
-                   :unintern ',unintern
-                   :fmakunbound ',redefined-functions)))
+                   :shadow ',shadow :unintern ',unintern
+                   :fmakunbound ',fmakunbound :fmakunbound-setf ',fmakunbound-setf)))
           (pkgdcl
            :asdf
            :use (:common-lisp)
-           :redefined-functions
+           :fmakunbound
            (#:perform #:explain #:output-files #:operation-done-p #:do-traverse
             #:compute-action-stamp #:component-load-dependencies #:traverse-action
             #:component-depends-on #:perform-plan #:mark-operation-done
@@ -243,6 +247,7 @@
             #:system-relative-pathname #:source-file-type #:builtin-system-p
             #:inherit-source-registry #:process-source-registry #:process-source-registry-directive
             #:compile-file* #:source-file-type #:trivial-system-p)
+           :fmakunbound-setf (#:output-translations)
            :unintern
            (#:*asdf-revision* #:around #:asdf-method-combination
             #:split #:make-collector #:do-dep #:do-one-dep #:visit-action #:component-visited-p
@@ -366,36 +371,7 @@
             #:user-source-registry
             #:system-source-registry
             #:user-source-registry-directory
-            #:system-source-registry-directory
-
-            ;; Utilities: please use asdf-utils instead
-            #|
-            ;; #:aif #:it
-            ;; #:appendf #:orf
-            #:length=n-p
-            #:remove-keys #:remove-keyword
-            #:first-char #:last-char #:string-suffix-p
-            #:coerce-name
-            #:directory-pathname-p #:ensure-directory-pathname
-            #:absolute-pathname-p #:ensure-pathname-absolute #:pathname-root
-            #:getenv #:getenv-pathname #:getenv-pathnames
-            #:getenv-absolute-directory #:getenv-absolute-directories
-            #:probe-file*
-            #:find-symbol* #:strcat
-            #:make-pathname-component-logical #:make-pathname-logical
-            #:merge-pathnames* #:coerce-pathname #:subpathname #:subpathname*
-            #:pathname-directory-pathname #:pathname-parent-directory-pathname
-            #:read-file-forms
-            #:resolve-symlinks #:truenamize
-            #:split-string
-            #:component-name-to-pathname-components
-            #:split-name-type
-            #:subdirectories #:directory-files
-            #:while-collecting
-            #:*wild* #:*wild-file* #:*wild-directory* #:*wild-inferiors*
-            #:*wild-path* #:wilden
-            #:directorize-pathname-host-device|#
-            )))
+            #:system-source-registry-directory)))
         #+genera (import 'scl:boolean :asdf)
         (setf *asdf-version* asdf-version
               *upgraded-p* (if existing-version
@@ -2171,7 +2147,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
 (defmethod find-operation ((operation operation) (sub symbol))
   (let* ((ancestor (operation-ancestor operation))
          (operations (operation-children-by-name ancestor)))
-    (or (values (gethash sub operations))
+    (or (gethash sub operations)
         (let ((new (if (eq sub (type-of ancestor))
                        ancestor
                        (make-instance sub :parent ancestor))))
@@ -2270,16 +2246,13 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
                (gethash name override)
                t)))))
 
-(defmethod operation-done-p ((o prepare-op) (c component))
-  (and (not (operation-forced-p o c)) (call-next-method)))
-
 (defun* visit-dependencies (operation component fun &aux stamp)
   (loop :for (dep-o-spec . dep-c-specs) :in (component-depends-on operation component)
         :unless (eq dep-o-spec 'feature) ;; avoid the "FEATURE" misfeature
           :do (loop :with dep-o = (find-operation operation dep-o-spec)
                     :for dep-c-spec :in dep-c-specs
-                    :for dep-c = (resolve-dependency-spec component dep-c-spec) :do
-                      (latest-stamp-f stamp (funcall fun dep-o dep-c))))
+                    :for dep-c = (resolve-dependency-spec component dep-c-spec)
+                    :do (latest-stamp-f stamp (funcall fun dep-o dep-c))))
   stamp)
 
 (defgeneric* needed-in-image-p (operation component))
@@ -2296,7 +2269,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
   (and (action-override-p o c 'operation-forced) (not (builtin-system-p c))))
 
 (defmethod operation-forced-not-p ((o operation) (c component))
-  (action-override-p o c 'operation-forced-not))
+  (and (action-override-p o c 'operation-forced-not) (not (operation-forced-p o c))))
 
 (defgeneric action-valid-p (operation component)
   (:documentation "Is this action valid to include amongst dependencies?"))
@@ -2304,8 +2277,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
   (declare (ignorable o c))
   (aif (component-if-feature c) (featurep it) t))
 (defmethod action-valid-p ((o operation) (s system))
-  (and (or (operation-forced-p o s) (not (operation-forced-not-p o s)))
-       (call-next-method)))
+  (and (not (operation-forced-not-p o s)) (call-next-method)))
 (defmethod action-valid-p ((o null) c) (declare (ignorable o c)) nil)
 (defmethod action-valid-p (o (c null)) (declare (ignorable o c)) nil)
 
@@ -2363,7 +2335,8 @@ If true, an integer indexing the action in the list of actions planned."))
   (setf (gethash (node-for o c) (plan-visited-actions plan)) new-status))
 
 (defmethod plan-action-status ((plan plan-traversal) (o operation) (c component))
-  (values (gethash (node-for o c) (plan-visited-actions plan))))
+  (or (and (operation-forced-not-p o c) (plan-action-status nil o c))
+      (values (gethash (node-for o c) (plan-visited-actions plan)))))
 
 (defmethod component-operation-time ((o operation) (c component))
   (gethash (type-of o) (component-operation-times c)))
@@ -2372,6 +2345,9 @@ If true, an integer indexing the action in the list of actions planned."))
   (setf (gethash (type-of o) (component-operation-times c))
         (compute-action-stamp o c :just-done t)))
 
+(defun* action-already-done-p (plan operation component)
+  (action-done-p (plan-action-status plan operation component)))
+
 (defmethod plan-action-status ((plan null) (o operation) (c component))
   (declare (ignorable plan))
   (multiple-value-bind (stamp done-p) (component-operation-time o c)
@@ -2426,7 +2402,7 @@ If true, an integer indexing the action in the list of actions planned."))
     ;; Any race condition is intrinsic to the limited timestamp resolution.
     (if (or just-done ;; The done-stamp is valid: if we're just done, or
             ;; if all filesystem effects are up-to-date and there's no invalidating reason.
-            (and all-present up-to-date-p (operation-done-p o c)))
+            (and all-present up-to-date-p (operation-done-p o c) (not (operation-forced-p o c))))
         (values done-stamp ;; return the hard-earned timestamp
                 (or just-done
                     (or out-op ;; a file-creating op is done when all files are up to date
@@ -2499,7 +2475,7 @@ If true, an integer indexing the action in the list of actions planned."))
 (defmethod traverse ((o operation) (c component))
   (let ((plan (make-instance 'sequential-plan)))
     (traverse-action plan o c t)
-    (reverse (plan-actions-r plan))))
+    (reverse (plan-actions-r plan)))) ;; backward compat: return a list, not the plan object.
 
 (defmethod perform ((o operation) (c source-file))
   (sysdef-error
@@ -2913,7 +2889,7 @@ T to force the inside of the specified system to be rebuilt (resp. not),
   (map () 'load-system systems))
 
 (defun* component-loaded-p (c)
-  (action-done-p (plan-action-status nil (make-instance 'load-op) (find-component c ()))))
+  (action-already-done-p nil (make-instance 'load-op) (find-component c ())))
 
 (defun* already-loaded-systems ()
   (remove-if-not 'component-loaded-p (registered-systems)))
-- 
GitLab