Changeset 14883

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

Update to asdf-

2 edited


  • trunk/abcl/doc/asdf/asdf.texinfo

    r14873 r14883  
    6767@title ASDF: Another System Definition Facility
    68 @subtitle Manual for Version
     68@subtitle Manual for Version
    6969@c The following two commands start the copyright page.
  • trunk/abcl/src/org/armedbear/lisp/asdf.lisp

    r14873 r14883  
    11;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-
    2 ;;; This is ASDF Another System Definition Facility.
     2;;; This is ASDF Another System Definition Facility.
    44;;; Feedback, bug reports, and patches are all welcome:
    24112411;;; Parsing filenames
    24122412(with-upgradability ()
     2413  (declaim (ftype function ensure-pathname)) ; forward reference
    24132415  (defun split-unix-namestring-directory-components
    24142416      (unix-namestring &key ensure-directory dot-dot)
    39893991            :until (eq form eof)
    39903992            :do (setf results (multiple-value-list (eval form)))
    3991             :finally (return (apply 'values results)))))
     3993            :finally (return (values-list results)))))
    39933995  (defun eval-thunk (thunk)
    41154117                 (after (return (call-function after okp)))
    41164118                 ((and want-pathname-p (not want-stream-p)) (return (call-function thunk okp)))
    4117                  (t (return (apply 'values results)))))
     4119                 (t (return (values-list results)))))
    41184120          (when (and okp (not (call-function keep)))
    41194121            (ignore-errors (delete-file-if-exists okp))))))
    45294531                          t))))
    45304532        (if lisp-interaction
    4531             (apply 'values results)
     4533            (values-list results)
    45324534            (shell-boolean-exit (first results)))))))
    45614563    (call-image-dump-hook)
    45624564    (setf *image-restored-p* nil)
    4563     #-(or clisp clozure cmucl lispworks sbcl scl)
     4565    #-(or clisp clozure (and cmucl executable) lispworks sbcl scl)
    45644566    (when executable
    45654567      (error "Dumping an executable is not supported on this implementation! Aborting."))
    45954597      (setf ext::*gc-run-time* 0)
    45964598      (apply 'ext:save-lisp filename
    4597              #+cmucl :executable #+cmucl t
    4598              (when executable '(:init-function restore-image :process-command-line nil))))
     4599             :allow-other-keys t ;; hush SCL and old versions of CMUCL
     4600             #+(and cmucl executable) :executable #+(and cmucl executable) t
     4601             (when executable '(:init-function restore-image :process-command-line nil
     4602                                :quiet t :load-init-file nil :site-init nil))))
    45994603    #+gcl
    46004604    (progn
    71647168   #:asdf-message #:*verbose-out*
    71657169   #:upgrading-p #:when-upgrading #:upgrade-asdf #:defparameter*
    7166    #:*post-upgrade-cleanup-hook* #:*post-upgrade-restart-hook* #:cleanup-upgraded-asdf
     7170   #:*post-upgrade-cleanup-hook* #:cleanup-upgraded-asdf
    71677171   ;; There will be no symbol left behind!
    71687172   #:intern*)
    72087212  ;; Private hook for functions to run after ASDF has upgraded itself from an older variant:
    72097213  (defvar *post-upgrade-cleanup-hook* ())
    7210   ;; Private hook for functions to run after ASDF is restarted, whether by starting a process
    7211   ;; from a dumped image or after upgrading from an older variant:
    7212   ;; TODO: understand what happened with that hook, why functions are registered on it but it is
    7213   ;; never called anymore. This is a bug that should be fixed before next release (3.1.8)!
    7214   (defvar *post-upgrade-restart-hook* ())
    72157214  ;; Private function to detect whether the current upgrade counts as an incompatible
    72167215  ;; data schema upgrade implying the need to drop data.
    72507249         ;; "" would be your eighth local modification of official release 3.4.5
    72517250         ;; "" would be your eighth local modification of development version
    7252          (asdf-version "")
     7251         (asdf-version "")
    72537252         (existing-version (asdf-version)))
    72547253    (setf *asdf-version* asdf-version)
    73127311          (*compile-print* nil))
    73137312      (handler-bind (((or style-warning) #'muffle-warning))
    7314         (symbol-call :asdf :load-system :asdf :verbose nil))))
    7316   ;; Register the upgrade-configuration function from UIOP,
    7317   ;; to ensure configuration is upgraded as needed.
    7318   (register-hook-function '*post-upgrade-cleanup-hook* 'upgrade-configuration))
     7313        (symbol-call :asdf :load-system :asdf :verbose nil)))))
    73207314;;;; -------------------------------------------------------------------------
    73217315;;;; Components
    73697363  (defgeneric component-pathname (component)
    73707364    (:documentation "Pathname of the COMPONENT if any, or NIL."))
    7371   (defgeneric (component-relative-pathname) (component)
     7365  (defgeneric* (component-relative-pathname) (component)
    73727366    ;; in ASDF4, rename that to component-specified-pathname ?
    73737367    (:documentation "Specified pathname of the COMPONENT,
    73987392  ;; Deprecated: Backward compatible way of computing the FILE-TYPE of a component.
    73997393  ;; TODO: find users, have them stop using that, remove it for ASDF4.
    7400   (defgeneric (source-file-type) (component system)
     7394  (defgeneric* (source-file-type) (component system)
    74017395    (:documentation "DEPRECATED. Use the FILE-TYPE of a COMPONENT instead."))
    77637757    (system-source-file (find-system system-name)))
    77647758  (defmethod system-source-file ((system-name symbol))
    7765     (system-source-file (find-system system-name)))
     7759    (when system-name
     7760      (system-source-file (find-system system-name))))
    77677762  (defun system-source-directory (system-designator)
    77707765    (pathname-directory-pathname (system-source-file system-designator)))
    7772   (defun (system-relative-pathname) (system name &key type)
     7767  (defun* (system-relative-pathname) (system name &key type)
    77737768    "Given a SYSTEM, and a (Unix-style relative path) NAME of a file (or directory) of given TYPE,
    77747769return the absolute pathname of a corresponding file under that system's source code pathname."
    80418036                    system)))))
     8038  (defun map-systems (fn)
     8039    "Apply FN to each defined system.
     8041FN should be a function of one argument. It will be
     8042called with an object of type asdf:system."
     8043    (loop :for registered :being :the :hash-values :of *defined-systems*
     8044          :do (funcall fn (cdr registered))))
    80448047  ;;; Preloaded systems: in the image even if you can't find source files backing them.
    80718074    (if-let (system (and (not (registered-system name)) (sysdef-preloaded-system-search name)))
    80728075      (register-system system)))
    8074   (defun ensure-all-preloaded-systems-registered ()
    8075     "Make sure all registered preloaded systems are defined.
    8076 This function is run whenever ASDF is upgraded."
    8077     (loop :for name :being :the :hash-keys :of *preloaded-systems*
    8078           :do (ensure-preloaded-system-registered name)))
    8079   (register-hook-function '*post-upgrade-restart-hook* 'ensure-all-preloaded-systems-registered)
    80818077  (defun register-preloaded-system (system-name &rest keys &key (version t) &allow-other-keys)
    81488144Preloaded systems (including immutable ones) will be reset, other systems will be de-registered."
    81498145    (loop :for name :being :the :hash-keys :of *defined-systems*
    8150           :unless (equal name "asdf") :do (clear-system name)))
    8152   (register-hook-function '*post-upgrade-cleanup-hook* 'clear-defined-systems nil)
    8154   (defun map-systems (fn)
    8155     "Apply FN to each defined system.
    8157 FN should be a function of one argument. It will be
    8158 called with an object of type asdf:system."
    8159     (loop :for registered :being :the :hash-values :of *defined-systems*
    8160           :do (funcall fn (cdr registered))))
     8146          :unless (member name '("asdf" "uiop") :test 'equal) :do (clear-system name)))
    83708356              (list (namestring pathname) version) *old-asdf-systems*
    83718357              #'(lambda ()
    8372                  (let ((old-pathname
    8373                          (if-let (pair (system-registered-p "asdf"))
    8374                            (system-source-file (cdr pair)))))
     8358                 (let ((old-pathname (system-source-file (registered-system "asdf"))))
    83758359                   (warn "~@<~
    83768360        You are using ASDF version ~A ~:[(probably from (require \"asdf\") ~
    84208404             (pathname (ensure-pathname
    84218405                        (or (and (typep found '(or pathname string)) (pathname found))
    8422                             (and found-system (system-source-file found-system))
    8423                             (and previous (system-source-file previous)))
     8406                            (system-source-file found-system)
     8407                            (system-source-file previous))
    84248408                        :want-absolute t :resolve-symlinks *resolve-symlinks*))
    84258409             (foundp (and (or found-system pathname previous) t)))
    84448428              (locate-system name)
    84458429            (assert (eq foundp (and (or found-system pathname previous) t)))
    8446             (let ((previous-pathname (and previous (system-source-file previous)))
     8430            (let ((previous-pathname (system-source-file previous))
    84478431                  (system (or previous found-system)))
    84488432              (when (and found-system (not previous))
    86048588          (unless (component-parent component)
    86058589            (let ((name (coerce-name name)))
    8606               (unset-asdf-cache-entry `(find-system ,name))
    8607               (unset-asdf-cache-entry `(locate-system ,name))))))))
     8590              (unset-asdf-cache-entry `(find-system ,name))))))))
    86098592  ;; Resolve dependency specification DEP-SPEC in the context of COMPONENT.
    87188701  (:export
    87198702   #:action #:define-convenience-action-methods
    8720    #:explain #:action-description
     8703   #:action-description
    87218704   #:downward-operation #:upward-operation #:sideway-operation #:selfward-operation #:non-propagating-operation
    87228705   #:component-depends-on
    87258708   #:component-operation-time #:mark-operation-done #:compute-action-stamp
    87268709   #:perform #:perform-with-restarts #:retry #:accept
    8727    #:traverse-actions #:traverse-sub-actions #:required-components ;; in plan
    87288710   #:action-path #:find-action #:stamp #:done-p
    87298711   #:operation-definition-warning #:operation-definition-error ;; condition
    87428724and a class-name or class designates the canonical instance of the designated class."
    87438725    '(or operation null symbol class)))
    8746 ;;; TODO: These should be moved to asdf/plan and be made simple defuns.
    8747 (with-upgradability ()
    8748   (defgeneric traverse-actions (actions &key &allow-other-keys))
    8749   (defgeneric traverse-sub-actions (operation component &key &allow-other-keys))
    8750   (defgeneric required-components (component &key &allow-other-keys)))
    88248799    (format nil (compatfmt "~@<~A on ~A~@:>")
    88258800            (type-of operation) component))
    8827   ;; This is for compatibility with ASDF 1, and is deprecated.
    8828   ;; TODO: move it to backward-interface
    8829   (defgeneric* (explain) (operation component)
    8830     (:documentation "Display a message describing an action"))
    8831   (defmethod explain ((o operation) (c component))
    8832     (asdf-message (compatfmt "~&~@<; ~@;~A~:>~%") (action-description o c)))
    8833   (define-convenience-action-methods explain (operation component))
    88358802  (defun format-action (stream action &optional colon-p at-sign-p)
    96219588;;;; Visiting dependencies of an action and computing action stamps
    96229589(with-upgradability ()
    9623   (defun (map-direct-dependencies) (plan operation component fun)
     9590  (defun* (map-direct-dependencies) (plan operation component fun)
    96249591    "Call FUN on all the valid dependencies of the given action in the given plan"
    96259592    (loop* :for (dep-o-spec . dep-c-specs) :in (component-depends-on operation component)
    96319598                       :do (funcall fun dep-o dep-c))))
    9633   (defun (reduce-direct-dependencies) (plan operation component combinator seed)
     9600  (defun* (reduce-direct-dependencies) (plan operation component combinator seed)
    96349601    "Reduce the direct dependencies to a value computed by iteratively calling COMBINATOR
    96359602for each dependency action on the dependency's operation and component and an accumulator
    96419608    seed)
    9643   (defun (direct-dependencies) (plan operation component)
     9610  (defun* (direct-dependencies) (plan operation component)
    96449611    "Compute a list of the direct dependencies of the action within the plan"
    96459612    (reduce-direct-dependencies plan operation component #'acons nil))
    99359902         (call-next-method)))
    9937   (defmethod traverse-actions (actions &rest keys &key plan-class &allow-other-keys)
     9904  (defun* (traverse-actions) (actions &rest keys &key plan-class &allow-other-keys)
    99389905    "Given a list of actions, build a plan with these actions as roots."
    99399906    (let ((plan (apply 'make-instance (or plan-class 'filtered-sequential-plan) keys)))
    99419908      plan))
     9910  (defgeneric traverse-sub-actions (operation component &key &allow-other-keys))
    99439911  (define-convenience-action-methods traverse-sub-actions (operation component &key))
    99449912  (defmethod traverse-sub-actions ((operation operation) (component component)
    99539921             :collect (cons o c))))
    9955   (defmethod required-components (system &rest keys &key (goal-operation 'load-op) &allow-other-keys)
     9923  (defun* (required-components) (system &rest keys &key (goal-operation 'load-op) &allow-other-keys)
    99569924    "Given a SYSTEM and a GOAL-OPERATION (default LOAD-OP), traverse the dependencies and
    99579925return a list of the components involved in building the desired action."
    99729940  (:export
    99739941   #:operate #:oos
    9974    #:*systems-being-operated*
    99759942   #:build-op #:make
    99769943   #:load-system #:load-systems #:load-systems*
    100149981    :if-no-component (error 'missing-component :requires component))
    10016   ;; TODO: actually, the use as a hash-set is write-only, so it can be reduced to a boolean,
    10017   ;; and then possibly replaced by checking for say *asdf-cache*.
    10018   (defvar *systems-being-operated* nil
    10019     "A hash-set of names of systems being operated on, or NIL")
     9983  (defvar *in-operate* nil
     9984    "Are we in operate?")
    100219986  ;; This method ensures that an ASDF upgrade is attempted as the very first thing,
    100269991                                (on-warnings *compile-file-warnings-behaviour*)
    100279992                                (on-failure *compile-file-failure-behaviour*) &allow-other-keys)
    10028     (let* ((systems-being-operated *systems-being-operated*)
    10029            (*systems-being-operated* (or systems-being-operated (make-hash-table :test 'equal)))
     9993    (nest
     9994     (with-asdf-cache ())
     9995     (let ((in-operate *in-operate*)
     9996           (*in-operate* t)
    100309997           (operation-remaker ;; how to remake the operation after ASDF was upgraded (if it was)
    10031              (etypecase operation
    10032                (operation (let ((name (type-of operation))
    10033                                 (initargs (operation-original-initargs operation)))
    10034                             #'(lambda () (apply 'make-operation name :original-initargs initargs initargs))))
    10035                ((or symbol string) (constantly operation))))
     9998            (etypecase operation
     9999              (operation (let ((name (type-of operation))
     10000                               (initargs (operation-original-initargs operation)))
     10001                           #'(lambda () (apply 'make-operation name :original-initargs initargs initargs))))
     10002              ((or symbol string) (constantly operation))))
    1003610003           (component-path (typecase component ;; to remake the component after ASDF upgrade
    1003710004                             (component (component-find-path component))
    10038                              (t component))))
    10039       ;; Before we operate on any system, make sure ASDF is up-to-date,
    10040       ;; for if an upgrade is ever attempted at any later time, there may be BIG trouble.
    10041       (unless systems-being-operated
    10042         (when (upgrade-asdf)
    10043           ;; If we were upgraded, restart OPERATE the hardest of ways, for
    10044           ;; its function may have been redefined, its symbol uninterned, its package deleted.
    10045           (return-from operate
    10046             (apply 'operate (funcall operation-remaker) component-path keys))))
     10005                             (t component)))))
     10006     ;; Before we operate on any system, make sure ASDF is up-to-date,
     10007     ;; for if an upgrade is ever attempted at any later time, there may be BIG trouble.
     10008     (progn
     10009       (unless in-operate
     10010         (when (upgrade-asdf)
     10011           ;; If we were upgraded, restart OPERATE the hardest of ways, for
     10012           ;; its function may have been redefined, its symbol uninterned, its package deleted.
     10013           (return-from operate
     10014             (apply 'operate (funcall operation-remaker) component-path keys)))))
    1004710015      ;; Setup proper bindings around any operate call.
    10048       (with-asdf-cache ()
    10049         (let* ((*verbose-out* (and verbose *standard-output*))
    10050                (*compile-file-warnings-behaviour* on-warnings)
    10051                (*compile-file-failure-behaviour* on-failure))
    10052           (call-next-method)))))
     10016     (let* ((*verbose-out* (and verbose *standard-output*))
     10017            (*compile-file-warnings-behaviour* on-warnings)
     10018            (*compile-file-failure-behaviour* on-failure))
     10019       (call-next-method))))
    1005410021  (defmethod operate :before ((operation operation) (component component)
    1005510022                              &key version &allow-other-keys)
    10056     (let ((system (component-system component)))
    10057       (setf (gethash (coerce-name system) *systems-being-operated*) system))
    1005810023    (unless (version-satisfies component version)
    1005910024      (error 'missing-component-of-version :requires component :version version)))
    1014210107Note that this returns true even if the component is not up to date."
    1014310108    (if-let ((component (find-component component () :registered t)))
    10144       (action-already-done-p nil (make-instance 'load-op) component)))
     10109      (action-already-done-p nil (make-operation 'load-op) component)))
    1014610111  (defun already-loaded-systems ()
    1022610191  (defun restart-upgraded-asdf ()
    1022710192    ;; If we're in the middle of something, restart it.
    10228     (when *asdf-cache*
    10229       (let ((l (loop :for k :being :the hash-keys :of *asdf-cache*
    10230                      :when (eq (first k) 'find-system) :collect (second k))))
    10231         (clrhash *asdf-cache*)
    10232         (dolist (s l) (find-system s nil)))))
    10233   (register-hook-function '*post-upgrade-restart-hook* 'restart-upgraded-asdf)
     10193    (let ((systems-being-defined
     10194           (when *asdf-cache*
     10195             (prog1
     10196                 (loop :for k :being :the hash-keys :of *asdf-cache*
     10197                   :when (eq (first k) 'find-system) :collect (second k))
     10198               (clrhash *asdf-cache*)))))
     10199      ;; Regardless, clear defined systems, since they might be invalid
     10200      ;; after an incompatible ASDF upgrade.
     10201      (clear-defined-systems)
     10202      ;; The configuration also may have to be upgraded.
     10203      (upgrade-configuration)
     10204      ;; If we were in the middle of an operation, be sure to restore the system being defined.
     10205      (dolist (s systems-being-defined) (find-system s nil))))
     10206  (register-hook-function '*post-upgrade-cleanup-hook* 'restart-upgraded-asdf)
    1023510208  ;; The following function's symbol is from asdf/find-system.
    1029610269                                   ((eql t) -1)
    1029710270                                   (pathname
    10298                                     (let ((directory (pathname-directory (car x))))
     10271                                    (let ((directory
     10272                                           (normalize-pathname-directory-component
     10273                                            (pathname-directory (car x)))))
    1029910274                                      (if (listp directory) (length directory) 0))))))))
    1030010275    new-value)
    1113911114    (mapcar 'parse-dependency-def dd-list))
    11141   (defun (parse-component-form) (parent options &key previous-serial-component)
     11116  (defun* (parse-component-form) (parent options &key previous-serial-component)
    1114211117    (destructuring-bind
    1114311118        (type name &rest rest &key
    1134111316    (:documentation "Abstract operation for linking files together"))
    11343   (defclass gather-op (bundle-op)
    11344     ;; TODO: rename the slot and reader gather-op to gather-operation
    11345     ((gather-op :initform nil :allocation :class :reader gather-op)
     11318  (defclass gather-operation (bundle-op)
     11319    ((gather-operation :initform nil :allocation :class :reader gather-operation)
    1134611320     (gather-type :initform :no-output-file :allocation :class :reader gather-type))
    1134711321    (:documentation "Abstract operation for gathering many input files from a system"))
    1135611330  ;; Non-monolithic operations typically use compile-op as the dependent operation,
    1135711331  ;; and all transitive sub-components as required components (excluding other systems).
    11358   (defmethod component-depends-on ((o gather-op) (s system))
     11332  (defmethod component-depends-on ((o gather-operation) (s system))
    1135911333    (let* ((mono (operation-monolithic-p o))
    1136011334           (deps
    1136511339      ;; NB: the explicit make-operation on ECL and MKCL
    1136611340      ;; ensures that we drop the original-initargs and its magic flags when recursing.
    11367       `((,(make-operation (or (gather-op o) (if mono 'lib-op 'compile-op))) ,@deps)
     11341      `((,(or (gather-operation o) (if mono 'lib-op 'compile-op)) ,@deps)
    1136811342        ,@(call-next-method))))
    1138211356    (:documentation "Operation class for loading the bundles of a system's dependencies"))
    11384   (defclass lib-op (link-op gather-op non-propagating-operation)
     11358  (defclass lib-op (link-op gather-operation non-propagating-operation)
    1138511359    ((gather-type :initform :object :allocation :class)
    1138611360     (bundle-type :initform :lib :allocation :class))
    1139611370  (defclass compile-bundle-op (basic-compile-bundle-op selfward-operation
    11397                                #+(or clasp ecl mkcl) link-op #-(or clasp ecl) gather-op)
     11371                               #+(or clasp ecl mkcl) link-op #-(or clasp ecl) gather-operation)
    1139811372    ((selfward-operation :initform '(prepare-bundle-op #+(or clasp ecl) lib-op)
    1139911373                         :allocation :class))
    1141511389  ;; but instead inherit from a basic-FOO-op as with basic-compile-bundle-op above.
    11417   (defclass dll-op (link-op gather-op non-propagating-operation)
     11391  (defclass dll-op (link-op gather-operation non-propagating-operation)
    1141811392    ((gather-type :initform :object :allocation :class)
    1141911393     (bundle-type :initform :dll :allocation :class))
    1144011414  (defclass monolithic-compile-bundle-op
    1144111415      (monolithic-bundle-op basic-compile-bundle-op
    11442        #+(or clasp ecl mkcl) link-op gather-op non-propagating-operation)
    11443     ((gather-op :initform #-(or clasp ecl mkcl) 'compile-bundle-op #+(or clasp ecl mkcl) 'lib-op
    11444                 :allocation :class)
    11445      (gather-type :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :static-library
    11446                   :allocation :class))
     11416       #+(or clasp ecl mkcl) link-op gather-operation non-propagating-operation)
     11417    ((gather-operation
     11418      :initform #-(or clasp ecl mkcl) 'compile-bundle-op #+(or clasp ecl mkcl) 'lib-op
     11419      :allocation :class)
     11420     (gather-type
     11421      :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :static-library
     11422      :allocation :class))
    1144711423    (:documentation "Create a single fasl for the system and its dependencies."))
    1146311439  (defclass image-op (monolithic-bundle-op selfward-operation
    11464                       #+(or clasp ecl mkcl) link-op #+(or clasp ecl mkcl) gather-op)
     11440                      #+(or clasp ecl mkcl) link-op #+(or clasp ecl mkcl) gather-operation)
    1146511441    ((bundle-type :initform :image)
    1146611442     #+(or clasp ecl mkcl) (gather-type :initform :static-library :allocation :class)
    1160311579    #'(lambda (p) (equalp (pathname-type p) type)))
    11605   (defmethod input-files ((o gather-op) (c system))
     11581  (defmethod input-files ((o gather-operation) (c system))
    1160611582    (unless (eq (bundle-type o) :no-output-file)
    1160711583      (direct-dependency-files
    1172411700    nil)
    11726   (defmethod component-depends-on ((o gather-op) (c prebuilt-system))
     11702  (defmethod component-depends-on ((o gather-operation) (c prebuilt-system))
    1172711703    nil)
    1188511861   :asdf/component :asdf/operation
    1188611862   :asdf/system :asdf/find-system
    11887    :asdf/action :asdf/lisp-action :asdf/bundle)
     11863   :asdf/action :asdf/lisp-action :asdf/plan :asdf/bundle)
    1188811864  (:export
    1188911865   #:concatenate-source-op
    1190311879  ;; Base classes for both regular and monolithic concatenate-source operations
    1190411880  (defclass basic-concatenate-source-op (bundle-op)
    11905     ((bundle-type :initform "lisp")))
     11881    ((bundle-type :initform "lisp" :allocation :class)))
    1190611882  (defclass basic-load-concatenated-source-op (basic-load-op selfward-operation) ())
    1190711883  (defclass basic-compile-concatenated-source-op (basic-compile-op selfward-operation) ())
    1216412140   #:component-property
    1216512141   #:run-shell-command
    12166    #:system-definition-pathname))
     12142   #:system-definition-pathname
     12143   #:explain))
    1216712144(in-package :asdf/backward-interface)
    1220012177  ;; you should also do it when not, and vice-versa, because it really shouldn't matter.
    1220112178  ;; Thus, the backward-compatible thing to do is to always return T.
    12202   ;;
    12203   ;; TODO: change this function to a defun that always returns T.
    12204   (defmethod operation-forced ((o operation)) (getf (operation-original-initargs o) :force))
     12179  (defmethod operation-forced ((o operation)) t)
    1233012305          (t 255))))))
    1233212308(with-upgradability ()
    1233312309  (defvar *asdf-verbose* nil)) ;; backward-compatibility with ASDF2 only. Unused.
    12335 ;; backward-compatibility methods. Do NOT use in new code. NOT SUPPORTED.
     12312;;; backward-compatibility methods. Do NOT use in new code. NOT SUPPORTED.
    1233612313(with-upgradability ()
    1233712314  (defgeneric component-property (component property))
    1234812325                (acons property new-value (slot-value c 'properties)))))
    1234912326    new-value))
     12329;;; This method survives from ASDF 1, but really it is superseded by action-description.
     12330(with-upgradability ()
     12331  (defgeneric* (explain) (operation component)
     12332    (:documentation "Display a message describing an action.
     12334  (defmethod explain ((o operation) (c component))
     12335    (asdf-message (compatfmt "~&~@<; ~@;~A~:>~%") (action-description o c)))
     12336  (define-convenience-action-methods explain (operation component)))
    1235012339;;;; ---------------------------------------------------------------------------
    1235112340;;;; Handle ASDF package upgrade, including implementation-dependent magic.
Note: See TracChangeset for help on using the changeset viewer.