Changeset 14883

Timestamp:

10/01/16 13:27:03 (7 years ago)

Author:

Mark Evenson

Message:

Update to asdf-3.1.7.27

Location:

trunk/abcl

Files:

• doc/asdf/asdf.texinfo (modified) (1 diff)
• src/org/armedbear/lisp/asdf.lisp (modified) (55 diffs)

trunk/abcl/doc/asdf/asdf.texinfo

@@ -66 +66 @@
 @titlepage
 @title ASDF: Another System Definition Facility
-@subtitle Manual for Version 3.1.7.26
+@subtitle Manual for Version 3.1.7.27
 @c The following two commands start the copyright page.
 @page

trunk/abcl/src/org/armedbear/lisp/asdf.lisp

@@ -1 +1 @@
 ;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-
-;;; This is ASDF 3.1.7.26: Another System Definition Facility.
+;;; This is ASDF 3.1.7.27: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
@@ -2411 +2411 @@
 ;;; Parsing filenames
 (with-upgradability ()
+  (declaim (ftype function ensure-pathname)) ; forward reference
+
   (defun split-unix-namestring-directory-components
       (unix-namestring &key ensure-directory dot-dot)
@@ -3989 +3991 @@
             :until (eq form eof)
             :do (setf results (multiple-value-list (eval form)))
-            :finally (return (apply 'values results)))))
+            :finally (return (values-list results)))))
 
   (defun eval-thunk (thunk)
@@ -4115 +4117 @@
                  (after (return (call-function after okp)))
                  ((and want-pathname-p (not want-stream-p)) (return (call-function thunk okp)))
-                 (t (return (apply 'values results)))))
+                 (t (return (values-list results)))))
           (when (and okp (not (call-function keep)))
             (ignore-errors (delete-file-if-exists okp))))))
@@ -4529 +4531 @@
                           t))))
         (if lisp-interaction
-            (apply 'values results)
+            (values-list results)
             (shell-boolean-exit (first results)))))))
 
@@ -4561 +4563 @@
     (call-image-dump-hook)
     (setf *image-restored-p* nil)
-    #-(or clisp clozure cmucl lispworks sbcl scl)
+    #-(or clisp clozure (and cmucl executable) lispworks sbcl scl)
     (when executable
       (error "Dumping an executable is not supported on this implementation! Aborting."))
@@ -4595 +4597 @@
       (setf ext::*gc-run-time* 0)
       (apply 'ext:save-lisp filename
-             #+cmucl :executable #+cmucl t
-             (when executable '(:init-function restore-image :process-command-line nil))))
+             :allow-other-keys t ;; hush SCL and old versions of CMUCL
+             #+(and cmucl executable) :executable #+(and cmucl executable) t
+             (when executable '(:init-function restore-image :process-command-line nil
+                                :quiet t :load-init-file nil :site-init nil))))
     #+gcl
     (progn
@@ -7164 +7168 @@
    #:asdf-message #:*verbose-out*
    #:upgrading-p #:when-upgrading #:upgrade-asdf #:defparameter*
-   #:*post-upgrade-cleanup-hook* #:*post-upgrade-restart-hook* #:cleanup-upgraded-asdf
+   #:*post-upgrade-cleanup-hook* #:cleanup-upgraded-asdf
    ;; There will be no symbol left behind!
    #:intern*)
@@ -7208 +7212 @@
   ;; Private hook for functions to run after ASDF has upgraded itself from an older variant:
   (defvar *post-upgrade-cleanup-hook* ())
-  ;; Private hook for functions to run after ASDF is restarted, whether by starting a process
-  ;; from a dumped image or after upgrading from an older variant:
-  ;; TODO: understand what happened with that hook, why functions are registered on it but it is
-  ;; never called anymore. This is a bug that should be fixed before next release (3.1.8)!
-  (defvar *post-upgrade-restart-hook* ())
   ;; Private function to detect whether the current upgrade counts as an incompatible
   ;; data schema upgrade implying the need to drop data.
@@ -7250 +7249 @@
          ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
          ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
-         (asdf-version "3.1.7.26")
+         (asdf-version "3.1.7.27")
          (existing-version (asdf-version)))
     (setf *asdf-version* asdf-version)
@@ -7312 +7311 @@
           (*compile-print* nil))
       (handler-bind (((or style-warning) #'muffle-warning))
-        (symbol-call :asdf :load-system :asdf :verbose nil))))
-
-  ;; Register the upgrade-configuration function from UIOP,
-  ;; to ensure configuration is upgraded as needed.
-  (register-hook-function '*post-upgrade-cleanup-hook* 'upgrade-configuration))
-
+        (symbol-call :asdf :load-system :asdf :verbose nil)))))
 ;;;; -------------------------------------------------------------------------
 ;;;; Components
@@ -7369 +7363 @@
   (defgeneric component-pathname (component)
     (:documentation "Pathname of the COMPONENT if any, or NIL."))
-  (defgeneric (component-relative-pathname) (component)
+  (defgeneric* (component-relative-pathname) (component)
     ;; in ASDF4, rename that to component-specified-pathname ?
     (:documentation "Specified pathname of the COMPONENT,
@@ -7398 +7392 @@
   ;; Deprecated: Backward compatible way of computing the FILE-TYPE of a component.
   ;; TODO: find users, have them stop using that, remove it for ASDF4.
-  (defgeneric (source-file-type) (component system)
+  (defgeneric* (source-file-type) (component system)
     (:documentation "DEPRECATED. Use the FILE-TYPE of a COMPONENT instead."))
 
@@ -7763 +7757 @@
     (system-source-file (find-system system-name)))
   (defmethod system-source-file ((system-name symbol))
-    (system-source-file (find-system system-name)))
+    (when system-name
+      (system-source-file (find-system system-name))))
 
   (defun system-source-directory (system-designator)
@@ -7770 +7765 @@
     (pathname-directory-pathname (system-source-file system-designator)))
 
-  (defun (system-relative-pathname) (system name &key type)
+  (defun* (system-relative-pathname) (system name &key type)
     "Given a SYSTEM, and a (Unix-style relative path) NAME of a file (or directory) of given TYPE,
 return the absolute pathname of a corresponding file under that system's source code pathname."
@@ -8041 +8036 @@
                     system)))))
 
+  (defun map-systems (fn)
+    "Apply FN to each defined system.
+
+FN should be a function of one argument. It will be
+called with an object of type asdf:system."
+    (loop :for registered :being :the :hash-values :of *defined-systems*
+          :do (funcall fn (cdr registered))))
+
 
   ;;; Preloaded systems: in the image even if you can't find source files backing them.
@@ -8071 +8074 @@
     (if-let (system (and (not (registered-system name)) (sysdef-preloaded-system-search name)))
       (register-system system)))
-
-  (defun ensure-all-preloaded-systems-registered ()
-    "Make sure all registered preloaded systems are defined.
-This function is run whenever ASDF is upgraded."
-    (loop :for name :being :the :hash-keys :of *preloaded-systems*
-          :do (ensure-preloaded-system-registered name)))
-  (register-hook-function '*post-upgrade-restart-hook* 'ensure-all-preloaded-systems-registered)
 
   (defun register-preloaded-system (system-name &rest keys &key (version t) &allow-other-keys)
@@ -8148 +8144 @@
 Preloaded systems (including immutable ones) will be reset, other systems will be de-registered."
     (loop :for name :being :the :hash-keys :of *defined-systems*
-          :unless (equal name "asdf") :do (clear-system name)))
-
-  (register-hook-function '*post-upgrade-cleanup-hook* 'clear-defined-systems nil)
-
-  (defun map-systems (fn)
-    "Apply FN to each defined system.
-
-FN should be a function of one argument. It will be
-called with an object of type asdf:system."
-    (loop :for registered :being :the :hash-values :of *defined-systems*
-          :do (funcall fn (cdr registered))))
+          :unless (member name '("asdf" "uiop") :test 'equal) :do (clear-system name)))
 
 
@@ -8370 +8356 @@
               (list (namestring pathname) version) *old-asdf-systems*
               #'(lambda ()
-                 (let ((old-pathname
-                         (if-let (pair (system-registered-p "asdf"))
-                           (system-source-file (cdr pair)))))
+                 (let ((old-pathname (system-source-file (registered-system "asdf"))))
                    (warn "~@<~
         You are using ASDF version ~A ~:[(probably from (require \"asdf\") ~
@@ -8420 +8404 @@
              (pathname (ensure-pathname
                         (or (and (typep found '(or pathname string)) (pathname found))
-                            (and found-system (system-source-file found-system))
-                            (and previous (system-source-file previous)))
+                            (system-source-file found-system)
+                            (system-source-file previous))
                         :want-absolute t :resolve-symlinks *resolve-symlinks*))
              (foundp (and (or found-system pathname previous) t)))
@@ -8444 +8428 @@
               (locate-system name)
             (assert (eq foundp (and (or found-system pathname previous) t)))
-            (let ((previous-pathname (and previous (system-source-file previous)))
+            (let ((previous-pathname (system-source-file previous))
                   (system (or previous found-system)))
               (when (and found-system (not previous))
@@ -8604 +8588 @@
           (unless (component-parent component)
             (let ((name (coerce-name name)))
-              (unset-asdf-cache-entry `(find-system ,name))
-              (unset-asdf-cache-entry `(locate-system ,name))))))))
+              (unset-asdf-cache-entry `(find-system ,name))))))))
 
   ;; Resolve dependency specification DEP-SPEC in the context of COMPONENT.
@@ -8718 +8701 @@
   (:export
    #:action #:define-convenience-action-methods
-   #:explain #:action-description
+   #:action-description
    #:downward-operation #:upward-operation #:sideway-operation #:selfward-operation #:non-propagating-operation
    #:component-depends-on
@@ -8725 +8708 @@
    #:component-operation-time #:mark-operation-done #:compute-action-stamp
    #:perform #:perform-with-restarts #:retry #:accept
-   #:traverse-actions #:traverse-sub-actions #:required-components ;; in plan
    #:action-path #:find-action #:stamp #:done-p
    #:operation-definition-warning #:operation-definition-error ;; condition
@@ -8742 +8724 @@
 and a class-name or class designates the canonical instance of the designated class."
     '(or operation null symbol class)))
-
-
-;;; TODO: These should be moved to asdf/plan and be made simple defuns.
-(with-upgradability ()
-  (defgeneric traverse-actions (actions &key &allow-other-keys))
-  (defgeneric traverse-sub-actions (operation component &key &allow-other-keys))
-  (defgeneric required-components (component &key &allow-other-keys)))
 
 
@@ -8824 +8799 @@
     (format nil (compatfmt "~@<~A on ~A~@:>")
             (type-of operation) component))
-
-  ;; This is for compatibility with ASDF 1, and is deprecated.
-  ;; TODO: move it to backward-interface
-  (defgeneric* (explain) (operation component)
-    (:documentation "Display a message describing an action"))
-  (defmethod explain ((o operation) (c component))
-    (asdf-message (compatfmt "~&~@<; ~@;~A~:>~%") (action-description o c)))
-  (define-convenience-action-methods explain (operation component))
 
   (defun format-action (stream action &optional colon-p at-sign-p)
@@ -9621 +9588 @@
 ;;;; Visiting dependencies of an action and computing action stamps
 (with-upgradability ()
-  (defun (map-direct-dependencies) (plan operation component fun)
+  (defun* (map-direct-dependencies) (plan operation component fun)
     "Call FUN on all the valid dependencies of the given action in the given plan"
     (loop* :for (dep-o-spec . dep-c-specs) :in (component-depends-on operation component)
@@ -9631 +9598 @@
                        :do (funcall fun dep-o dep-c))))
 
-  (defun (reduce-direct-dependencies) (plan operation component combinator seed)
+  (defun* (reduce-direct-dependencies) (plan operation component combinator seed)
     "Reduce the direct dependencies to a value computed by iteratively calling COMBINATOR
 for each dependency action on the dependency's operation and component and an accumulator
@@ -9641 +9608 @@
     seed)
 
-  (defun (direct-dependencies) (plan operation component)
+  (defun* (direct-dependencies) (plan operation component)
     "Compute a list of the direct dependencies of the action within the plan"
     (reduce-direct-dependencies plan operation component #'acons nil))
@@ -9935 +9902 @@
          (call-next-method)))
 
-  (defmethod traverse-actions (actions &rest keys &key plan-class &allow-other-keys)
+  (defun* (traverse-actions) (actions &rest keys &key plan-class &allow-other-keys)
     "Given a list of actions, build a plan with these actions as roots."
     (let ((plan (apply 'make-instance (or plan-class 'filtered-sequential-plan) keys)))
@@ -9941 +9908 @@
       plan))
 
+  (defgeneric traverse-sub-actions (operation component &key &allow-other-keys))
   (define-convenience-action-methods traverse-sub-actions (operation component &key))
   (defmethod traverse-sub-actions ((operation operation) (component component)
@@ -9953 +9921 @@
              :collect (cons o c))))
 
-  (defmethod required-components (system &rest keys &key (goal-operation 'load-op) &allow-other-keys)
+  (defun* (required-components) (system &rest keys &key (goal-operation 'load-op) &allow-other-keys)
     "Given a SYSTEM and a GOAL-OPERATION (default LOAD-OP), traverse the dependencies and
 return a list of the components involved in building the desired action."
@@ -9972 +9940 @@
   (:export
    #:operate #:oos
-   #:*systems-being-operated*
    #:build-op #:make
    #:load-system #:load-systems #:load-systems*
@@ -10014 +9981 @@
     :if-no-component (error 'missing-component :requires component))
 
-  ;; TODO: actually, the use as a hash-set is write-only, so it can be reduced to a boolean,
-  ;; and then possibly replaced by checking for say *asdf-cache*.
-  (defvar *systems-being-operated* nil
-    "A hash-set of names of systems being operated on, or NIL")
+  (defvar *in-operate* nil
+    "Are we in operate?")
 
   ;; This method ensures that an ASDF upgrade is attempted as the very first thing,
@@ -10026 +9991 @@
                                 (on-warnings *compile-file-warnings-behaviour*)
                                 (on-failure *compile-file-failure-behaviour*) &allow-other-keys)
-    (let* ((systems-being-operated *systems-being-operated*)
-           (*systems-being-operated* (or systems-being-operated (make-hash-table :test 'equal)))
+    (nest
+     (with-asdf-cache ())
+     (let ((in-operate *in-operate*)
+           (*in-operate* t)
            (operation-remaker ;; how to remake the operation after ASDF was upgraded (if it was)
-             (etypecase operation
-               (operation (let ((name (type-of operation))
-                                (initargs (operation-original-initargs operation)))
-                            #'(lambda () (apply 'make-operation name :original-initargs initargs initargs))))
-               ((or symbol string) (constantly operation))))
+            (etypecase operation
+              (operation (let ((name (type-of operation))
+                               (initargs (operation-original-initargs operation)))
+                           #'(lambda () (apply 'make-operation name :original-initargs initargs initargs))))
+              ((or symbol string) (constantly operation))))
            (component-path (typecase component ;; to remake the component after ASDF upgrade
                              (component (component-find-path component))
-                             (t component))))
-      ;; Before we operate on any system, make sure ASDF is up-to-date,
-      ;; for if an upgrade is ever attempted at any later time, there may be BIG trouble.
-      (unless systems-being-operated
-        (when (upgrade-asdf)
-          ;; If we were upgraded, restart OPERATE the hardest of ways, for
-          ;; its function may have been redefined, its symbol uninterned, its package deleted.
-          (return-from operate
-            (apply 'operate (funcall operation-remaker) component-path keys))))
+                             (t component)))))
+     ;; Before we operate on any system, make sure ASDF is up-to-date,
+     ;; for if an upgrade is ever attempted at any later time, there may be BIG trouble.
+     (progn
+       (unless in-operate
+         (when (upgrade-asdf)
+           ;; If we were upgraded, restart OPERATE the hardest of ways, for
+           ;; its function may have been redefined, its symbol uninterned, its package deleted.
+           (return-from operate
+             (apply 'operate (funcall operation-remaker) component-path keys)))))
       ;; Setup proper bindings around any operate call.
-      (with-asdf-cache ()
-        (let* ((*verbose-out* (and verbose *standard-output*))
-               (*compile-file-warnings-behaviour* on-warnings)
-               (*compile-file-failure-behaviour* on-failure))
-          (call-next-method)))))
+     (let* ((*verbose-out* (and verbose *standard-output*))
+            (*compile-file-warnings-behaviour* on-warnings)
+            (*compile-file-failure-behaviour* on-failure))
+       (call-next-method))))
 
   (defmethod operate :before ((operation operation) (component component)
                               &key version &allow-other-keys)
-    (let ((system (component-system component)))
-      (setf (gethash (coerce-name system) *systems-being-operated*) system))
     (unless (version-satisfies component version)
       (error 'missing-component-of-version :requires component :version version)))
@@ -10142 +10107 @@
 Note that this returns true even if the component is not up to date."
     (if-let ((component (find-component component () :registered t)))
-      (action-already-done-p nil (make-instance 'load-op) component)))
+      (action-already-done-p nil (make-operation 'load-op) component)))
 
   (defun already-loaded-systems ()
@@ -10226 +10191 @@
   (defun restart-upgraded-asdf ()
     ;; If we're in the middle of something, restart it.
-    (when *asdf-cache*
-      (let ((l (loop :for k :being :the hash-keys :of *asdf-cache*
-                     :when (eq (first k) 'find-system) :collect (second k))))
-        (clrhash *asdf-cache*)
-        (dolist (s l) (find-system s nil)))))
-  (register-hook-function '*post-upgrade-restart-hook* 'restart-upgraded-asdf)
+    (let ((systems-being-defined
+           (when *asdf-cache*
+             (prog1
+                 (loop :for k :being :the hash-keys :of *asdf-cache*
+                   :when (eq (first k) 'find-system) :collect (second k))
+               (clrhash *asdf-cache*)))))
+      ;; Regardless, clear defined systems, since they might be invalid
+      ;; after an incompatible ASDF upgrade.
+      (clear-defined-systems)
+      ;; The configuration also may have to be upgraded.
+      (upgrade-configuration)
+      ;; If we were in the middle of an operation, be sure to restore the system being defined.
+      (dolist (s systems-being-defined) (find-system s nil))))
+  (register-hook-function '*post-upgrade-cleanup-hook* 'restart-upgraded-asdf)
 
   ;; The following function's symbol is from asdf/find-system.
@@ -10296 +10269 @@
                                    ((eql t) -1)
                                    (pathname
-                                    (let ((directory (pathname-directory (car x))))
+                                    (let ((directory
+                                           (normalize-pathname-directory-component
+                                            (pathname-directory (car x)))))
                                       (if (listp directory) (length directory) 0))))))))
     new-value)
@@ -11139 +11114 @@
     (mapcar 'parse-dependency-def dd-list))
 
-  (defun (parse-component-form) (parent options &key previous-serial-component)
+  (defun* (parse-component-form) (parent options &key previous-serial-component)
     (destructuring-bind
         (type name &rest rest &key
@@ -11341 +11316 @@
     (:documentation "Abstract operation for linking files together"))
 
-  (defclass gather-op (bundle-op)
-    ;; TODO: rename the slot and reader gather-op to gather-operation
-    ((gather-op :initform nil :allocation :class :reader gather-op)
+  (defclass gather-operation (bundle-op)
+    ((gather-operation :initform nil :allocation :class :reader gather-operation)
      (gather-type :initform :no-output-file :allocation :class :reader gather-type))
     (:documentation "Abstract operation for gathering many input files from a system"))
@@ -11356 +11330 @@
   ;; Non-monolithic operations typically use compile-op as the dependent operation,
   ;; and all transitive sub-components as required components (excluding other systems).
-  (defmethod component-depends-on ((o gather-op) (s system))
+  (defmethod component-depends-on ((o gather-operation) (s system))
     (let* ((mono (operation-monolithic-p o))
            (deps
@@ -11365 +11339 @@
       ;; NB: the explicit make-operation on ECL and MKCL
       ;; ensures that we drop the original-initargs and its magic flags when recursing.
-      `((,(make-operation (or (gather-op o) (if mono 'lib-op 'compile-op))) ,@deps)
+      `((,(or (gather-operation o) (if mono 'lib-op 'compile-op)) ,@deps)
         ,@(call-next-method))))
 
@@ -11382 +11356 @@
     (:documentation "Operation class for loading the bundles of a system's dependencies"))
 
-  (defclass lib-op (link-op gather-op non-propagating-operation)
+  (defclass lib-op (link-op gather-operation non-propagating-operation)
     ((gather-type :initform :object :allocation :class)
      (bundle-type :initform :lib :allocation :class))
@@ -11395 +11369 @@
 
   (defclass compile-bundle-op (basic-compile-bundle-op selfward-operation
-                               #+(or clasp ecl mkcl) link-op #-(or clasp ecl) gather-op)
+                               #+(or clasp ecl mkcl) link-op #-(or clasp ecl) gather-operation)
     ((selfward-operation :initform '(prepare-bundle-op #+(or clasp ecl) lib-op)
                          :allocation :class))
@@ -11415 +11389 @@
   ;; but instead inherit from a basic-FOO-op as with basic-compile-bundle-op above.
 
-  (defclass dll-op (link-op gather-op non-propagating-operation)
+  (defclass dll-op (link-op gather-operation non-propagating-operation)
     ((gather-type :initform :object :allocation :class)
      (bundle-type :initform :dll :allocation :class))
@@ -11440 +11414 @@
   (defclass monolithic-compile-bundle-op
       (monolithic-bundle-op basic-compile-bundle-op
-       #+(or clasp ecl mkcl) link-op gather-op non-propagating-operation)
-    ((gather-op :initform #-(or clasp ecl mkcl) 'compile-bundle-op #+(or clasp ecl mkcl) 'lib-op
-                :allocation :class)
-     (gather-type :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :static-library
-                  :allocation :class))
+       #+(or clasp ecl mkcl) link-op gather-operation non-propagating-operation)
+    ((gather-operation
+      :initform #-(or clasp ecl mkcl) 'compile-bundle-op #+(or clasp ecl mkcl) 'lib-op
+      :allocation :class)
+     (gather-type
+      :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :static-library
+      :allocation :class))
     (:documentation "Create a single fasl for the system and its dependencies."))
 
@@ -11462 +11438 @@
 
   (defclass image-op (monolithic-bundle-op selfward-operation
-                      #+(or clasp ecl mkcl) link-op #+(or clasp ecl mkcl) gather-op)
+                      #+(or clasp ecl mkcl) link-op #+(or clasp ecl mkcl) gather-operation)
     ((bundle-type :initform :image)
      #+(or clasp ecl mkcl) (gather-type :initform :static-library :allocation :class)
@@ -11603 +11579 @@
     #'(lambda (p) (equalp (pathname-type p) type)))
 
-  (defmethod input-files ((o gather-op) (c system))
+  (defmethod input-files ((o gather-operation) (c system))
     (unless (eq (bundle-type o) :no-output-file)
       (direct-dependency-files
@@ -11724 +11700 @@
     nil)
 
-  (defmethod component-depends-on ((o gather-op) (c prebuilt-system))
+  (defmethod component-depends-on ((o gather-operation) (c prebuilt-system))
     nil)
 
@@ -11885 +11861 @@
    :asdf/component :asdf/operation
    :asdf/system :asdf/find-system
-   :asdf/action :asdf/lisp-action :asdf/bundle)
+   :asdf/action :asdf/lisp-action :asdf/plan :asdf/bundle)
   (:export
    #:concatenate-source-op
@@ -11903 +11879 @@
   ;; Base classes for both regular and monolithic concatenate-source operations
   (defclass basic-concatenate-source-op (bundle-op)
-    ((bundle-type :initform "lisp")))
+    ((bundle-type :initform "lisp" :allocation :class)))
   (defclass basic-load-concatenated-source-op (basic-load-op selfward-operation) ())
   (defclass basic-compile-concatenated-source-op (basic-compile-op selfward-operation) ())
@@ -12164 +12140 @@
    #:component-property
    #:run-shell-command
-   #:system-definition-pathname))
+   #:system-definition-pathname
+   #:explain))
 (in-package :asdf/backward-interface)
 
@@ -12200 +12177 @@
   ;; you should also do it when not, and vice-versa, because it really shouldn't matter.
   ;; Thus, the backward-compatible thing to do is to always return T.
-  ;;
-  ;; TODO: change this function to a defun that always returns T.
-  (defmethod operation-forced ((o operation)) (getf (operation-original-initargs o) :force))
+  (defmethod operation-forced ((o operation)) t)
 
 
@@ -12330 +12305 @@
           (t 255))))))
 
+
 (with-upgradability ()
   (defvar *asdf-verbose* nil)) ;; backward-compatibility with ASDF2 only. Unused.
 
-;; backward-compatibility methods. Do NOT use in new code. NOT SUPPORTED.
+
+;;; backward-compatibility methods. Do NOT use in new code. NOT SUPPORTED.
 (with-upgradability ()
   (defgeneric component-property (component property))
@@ -12348 +12325 @@
                 (acons property new-value (slot-value c 'properties)))))
     new-value))
+
+
+;;; This method survives from ASDF 1, but really it is superseded by action-description.
+(with-upgradability ()
+  (defgeneric* (explain) (operation component)
+    (:documentation "Display a message describing an action.
+DEPRECATED. Use ASDF:ACTION-DESCRIPTION and/or ASDF::FORMAT-ACTION instead."))
+  (defmethod explain ((o operation) (c component))
+    (asdf-message (compatfmt "~&~@<; ~@;~A~:>~%") (action-description o c)))
+  (define-convenience-action-methods explain (operation component)))
+
+
 ;;;; ---------------------------------------------------------------------------
 ;;;; Handle ASDF package upgrade, including implementation-dependent magic.