Changeset 14626

02/12/14 19:11:06 (8 years ago)
Mark Evenson

asdf restores BUNDLE-OP as working.

2 edited


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

    r14604 r14626  
    38 ASDF Copyright @copyright{} 2001-2013 Daniel Barlow and contributors.
    40 This manual Copyright @copyright{} 2001-2013 Daniel Barlow and contributors.
    42 This manual revised @copyright{} 2009-2013 Robert P. Goldman and Francois-Rene Rideau.
     38ASDF Copyright @copyright{} 2001-2014 Daniel Barlow and contributors.
     40This manual Copyright @copyright{} 2001-2014 Daniel Barlow and contributors.
     42This manual revised @copyright{} 2009-2014 Robert P. Goldman and Francois-Rene Rideau.
    4444Permission is hereby granted, free of charge, to any person obtaining
    174174@emph{Nota Bene}:
    175175We have released ASDF 2.000 on May 31st 2010,
    176 and ASDF 3.0 on January 31st 2013.
     176and ASDF 3.0.0 on May 15th 2013.
    177177Releases of ASDF 2 and later have since then been included
    178178in all actively maintained CL implementations that used to bundle ASDF 1,
  • trunk/abcl/src/org/armedbear/lisp/asdf.lisp

    r14604 r14626  
    1 ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
    2 ;;; This is ASDF Another System Definition Facility.
     1;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-
     2;;; This is ASDF Another System Definition Facility.
    44;;; Feedback, bug reports, and patches are all welcome:
    5454  (setf ext:*gc-verbose* nil))
     56;;; pre 1.3.0 ABCL versions do not support the bundle-op on Mac OS X
     58(eval-when (:load-toplevel :compile-toplevel :execute)
     59  (unless (and (member :darwin *features*)
     60               (second (third (sys::arglist 'directory))))
     61    (push :abcl-bundle-op-supported *features*)))
    5663;; Punt on hard package upgrade: from ASDF1 always, and even from ASDF2 on most implementations.
    5764(eval-when (:load-toplevel :compile-toplevel :execute)
    7279      (when (and existing-version
    7380                 (< existing-version-number
    74         (or #+(or allegro clisp lispworks sbcl) 2.0 2.27)))
     81                    #+(or allegro clisp lispworks sbcl) 2.0
     82                    #-(or allegro clisp lispworks sbcl) 2.27))
    7583        (rename-package :asdf away)
    7684        (when *load-verbose*
    22422250actually-existing directory."
    22432251    (when pathname
     2252      ;; I tried using Allegro's excl:file-directory-p, but this cannot be done,
     2253      ;; because it rejects apparently legal pathnames as
     2254      ;; ill-formed. [2014/02/10:rpg]
    22442255      (let ((pathname (pathname pathname)))
    22452256        (flet ((check-one (x)
    28122823  (defun directory-exists-p (x)
    28132824    "Is X the name of a directory that exists on the filesystem?"
     2825    #+allegro
     2826    (excl:probe-directory x)
     2827    #+clisp
     2828    (handler-case (ext:probe-directory x)
     2829           (sys::simple-file-error ()
     2830             nil))
     2831    #-(or allegro clisp)
    28142832    (let ((p (probe-file* x :truename t)))
    28152833      (and (directory-pathname-p p) p)))
    28362854the entries which are physical yet when transformed by MERGER have a different TRUENAME.
    28372855This function is used as a helper to DIRECTORY-FILES to avoid invalid entries when using logical-pathnames."
    2838     (if (logical-pathname-p directory)
    2839         ;; Try hard to not resolve logical-pathname into physical pathnames;
    2840         ;; otherwise logical-pathname users/lovers will be disappointed.
    2841         ;; If directory* could use some implementation-dependent magic,
    2842         ;; we will have logical pathnames already; otherwise,
    2843         ;; we only keep pathnames for which specifying the name and
    2844         ;; translating the LPN commute.
    2845         (loop :for f :in entries
    2846               :for p = (or (and (logical-pathname-p f) f)
    2847                            (let* ((u (ignore-errors (call-function merger f))))
    2848                              ;; The first u avoids a cumbersome (truename u) error.
    2849                              ;; At this point f should already be a truename,
    2850                              ;; but isn't quite in CLISP, for it doesn't have :version :newest
    2851                              (and u (equal (truename* u) (truename* f)) u)))
    2852               :when p :collect p)
    2853         entries))
     2856    (remove-duplicates ;; on CLISP, querying ~/ will return duplicates
     2857     (if (logical-pathname-p directory)
     2858         ;; Try hard to not resolve logical-pathname into physical pathnames;
     2859         ;; otherwise logical-pathname users/lovers will be disappointed.
     2860         ;; If directory* could use some implementation-dependent magic,
     2861         ;; we will have logical pathnames already; otherwise,
     2862         ;; we only keep pathnames for which specifying the name and
     2863         ;; translating the LPN commute.
     2864         (loop :for f :in entries
     2865               :for p = (or (and (logical-pathname-p f) f)
     2866                            (let* ((u (ignore-errors (call-function merger f))))
     2867                              ;; The first u avoids a cumbersome (truename u) error.
     2868                              ;; At this point f should already be a truename,
     2869                              ;; but isn't quite in CLISP, for it doesn't have :version :newest
     2870                              (and u (equal (truename* u) (truename* f)) u)))
     2871               :when p :collect p)
     2872         entries)
     2873     :test 'pathname-equal))
    28552876  (defun directory-files (directory &optional (pattern *wild-file*))
    2856     "Return a list of the files in a directory according to the PATTERN,
    2857 which is not very portable to override. Try not resolve symlinks if implementation allows."
     2877    "Return a list of the files in a directory according to the PATTERN.
     2878Subdirectories should NOT be returned.
     2879  PATTERN defaults to a pattern carefully chosen based on the implementation;
     2880override the default at your own risk.
     2881  DIRECTORY-FILES tries NOT to resolve symlinks if the implementation
     2882permits this."
    28582883    (let ((dir (pathname directory)))
    28592884      (when (logical-pathname-p dir)
    28712896                              (when (equal :wild (pathname-type pattern))
    28722897                                (ignore-errors (directory* (make-pathname :type nil :defaults pat)))))))
    2873         (filter-logical-directory-results
    2874          directory entries
    2875          #'(lambda (f)
    2876              (make-pathname :defaults dir
    2877                             :name (make-pathname-component-logical (pathname-name f))
    2878                             :type (make-pathname-component-logical (pathname-type f))
    2879                             :version (make-pathname-component-logical (pathname-version f))))))))
     2898        (remove-if 'directory-pathname-p
     2899                   (filter-logical-directory-results
     2900                    directory entries
     2901                    #'(lambda (f)
     2902                        (make-pathname :defaults dir
     2903                                       :name (make-pathname-component-logical (pathname-name f))
     2904                                       :type (make-pathname-component-logical (pathname-type f))
     2905                                       :version (make-pathname-component-logical (pathname-version f)))))))))
    28812907  (defun subdirectories (directory)
    45784604  (defmethod slurp-input-stream ((x (eql 'string)) stream &key stripped)
    4579     (declare (ignorable x))
    45804605    (slurp-stream-string stream :stripped stripped))
    45824607  (defmethod slurp-input-stream ((x (eql :string)) stream &key stripped)
    4583     (declare (ignorable x))
    45844608    (slurp-stream-string stream :stripped stripped))
    45864610  (defmethod slurp-input-stream ((x (eql :lines)) stream &key count)
    4587     (declare (ignorable x))
    45884611    (slurp-stream-lines stream :count count))
    45904613  (defmethod slurp-input-stream ((x (eql :line)) stream &key (at 0))
    4591     (declare (ignorable x))
    45924614    (slurp-stream-line stream :at at))
    45944616  (defmethod slurp-input-stream ((x (eql :forms)) stream &key count)
    4595     (declare (ignorable x))
    45964617    (slurp-stream-forms stream :count count))
    45984619  (defmethod slurp-input-stream ((x (eql :form)) stream &key (at 0))
    4599     (declare (ignorable x))
    46004620    (slurp-stream-form stream :at at))
    46024622  (defmethod slurp-input-stream ((x (eql t)) stream &rest keys &key &allow-other-keys)
    4603     (declare (ignorable x))
    46044623    (apply 'slurp-input-stream *standard-output* stream keys))
    4606   (defmethod slurp-input-stream ((x null) stream &key)
    4607     (declare (ignorable x stream))
     4625  (defmethod slurp-input-stream ((x null) (stream t) &key)
    46084626    nil)
    46814699  (defmethod vomit-output-stream ((x (eql t)) stream &rest keys &key &allow-other-keys)
    4682     (declare (ignorable x))
    46834700    (apply 'vomit-output-stream *standard-input* stream keys))
    4685   (defmethod vomit-output-stream ((x null) stream &key)
    4686     (declare (ignorable x stream))
     4702  (defmethod vomit-output-stream ((x null) (stream t) &key)
    46874703    (values))
    64196435;; See
    6421 (asdf/package:define-package :asdf/upgrade
     6437(uiop/package:define-package :asdf/upgrade
    64226438  (:recycle :asdf/upgrade :asdf)
    64236439  (:use :uiop/common-lisp :uiop)
    64296445   ;; There will be no symbol left behind!
    64306446   #:intern*)
    6431   (:import-from :asdf/package #:intern* #:find-symbol*))
     6447  (:import-from :uiop/package #:intern* #:find-symbol*))
    64326448(in-package :asdf/upgrade)
    64686484    (and *previous-asdf-versions* (not (equal *asdf-version* (first *previous-asdf-versions*)))))
    64696485  (defmacro when-upgrading ((&key (upgrading-p '(upgrading-p)) when) &body body)
     6486    "A wrapper macro for code that should only be run when upgrading a
     6487previously-loaded version of ASDF."
    64706488    `(with-upgradability ()
    64716489       (when (and ,upgrading-p ,@(when when `(,when)))
    64816499         ;; "" would be your eighth local modification of official release 3.4.5
    64826500         ;; "" would be your eighth local modification of development version
    6483          (asdf-version "")
     6501         (asdf-version "")
    64846502         (existing-version (asdf-version)))
    64856503    (setf *asdf-version* asdf-version)
    65156533             #:resolve-relative-location-component #:resolve-absolute-location-component
    65166534             #:output-files-for-system-and-operation))) ; obsolete ASDF-BINARY-LOCATION function
    6517     (declare (ignorable redefined-functions uninterned-symbols))
    6518     (loop :for name :in (append redefined-functions)
     6535    (loop :for name :in redefined-functions
    65196536          :for sym = (find-symbol* name :asdf nil) :do
    65206537            (when sym
    65766593;;;; Components
    6578 (asdf/package:define-package :asdf/component
     6595(uiop/package:define-package :asdf/component
    65796596  (:recycle :asdf/component :asdf/defsystem :asdf/find-system :asdf)
    65806597  (:use :uiop/common-lisp :uiop :asdf/upgrade)
    66366653  (defgeneric (setf component-version) (new-version component))
    66376654  (defgeneric component-parent (component))
    6638   (defmethod component-parent ((component null)) (declare (ignorable component)) nil)
     6655  (defmethod component-parent ((component null)) nil)
    66406657  ;; Backward compatible way of computing the FILE-TYPE of a component.
    66576674                       (duplicate-names-name c))))))
    6661 (when-upgrading (:when (find-class 'component nil))
    6662   (defmethod reinitialize-instance :after ((c component) &rest initargs &key)
    6663     (declare (ignorable c initargs)) (values)))
    66656677(with-upgradability ()
    67186730  (defun component-find-path (component)
     6731    "Return a path from a root system to the COMPONENT.
     6732The return value is a list of component NAMES; a list of strings."
    67196733    (check-type component (or null component))
    67206734    (reverse
    67356749;; The tree typically but not necessarily follows the filesystem hierarchy.
    67366750(with-upgradability ()
    6737   (defclass child-component (component) ())
     6751  (defclass child-component (component) ()
     6752    (:documentation "A CHILD-COMPONENT is a component that may be part of
     6753a PARENT-COMPONENT."))
    67396755  (defclass file-component (child-component)
    67646780      :initform nil
    67656781      :initarg :default-component-class
    6766       :accessor module-default-component-class))))
     6782      :accessor module-default-component-class))
     6783  (:documentation "A PARENT-COMPONENT is a component that may have
    67686786(with-upgradability ()
    67776795                  (setf (gethash name hash) c))
    67786796        hash))))
    6780 (when-upgrading (:when (find-class 'module nil))
    6781   (defmethod reinitialize-instance :after ((m module) &rest initargs &key)
    6782     (declare (ignorable m initargs)) (values))
    6783   (defmethod update-instance-for-redefined-class :after
    6784       ((m module) added deleted plist &key)
    6785     (declare (ignorable m added deleted plist))
    6786     (when (and (member 'children added) (member 'components deleted))
    6787       (setf (slot-value m 'children)
    6788             ;; old ECLs provide an alist instead of a plist(!)
    6789             (if (or #+ecl (consp (first plist))) (or #+ecl (cdr (assoc 'components plist)))
    6790                 (getf plist 'components)))
    6791       (compute-children-by-name m))))
    67936798(with-upgradability ()
    68176822  (defmethod component-relative-pathname ((component component))
    6818     ;; source-file-type is backward-compatibility with ASDF1;
    6819     ;; we ought to be able to extract this from the component alone with COMPONENT-TYPE.
    6820     ;; TODO: track who uses it, and have them not use it anymore.
     6823    ;; SOURCE-FILE-TYPE below is strictly for backward-compatibility with ASDF1.
     6824    ;; We ought to be able to extract this from the component alone with COMPONENT-TYPE.
     6825    ;; TODO: track who uses it, and have them not use it anymore;
     6826    ;; maybe issue a WARNING (then eventually CERROR) if the two methods diverge?
    68216827    (parse-unix-namestring
    68226828     (or (and (slot-boundp component 'relative-pathname)
    68276833     :defaults (component-parent-pathname component)))
    6829   (defmethod source-file-type ((component parent-component) system)
    6830     (declare (ignorable component system))
     6835  (defmethod source-file-type ((component parent-component) (system parent-component))
    68316836    :directory)
    6833   (defmethod source-file-type ((component file-component) system)
    6834     (declare (ignorable system))
     6838  (defmethod source-file-type ((component file-component) (system parent-component))
    68356839    (file-type component)))
    68866890;;;; Systems
    6888 (asdf/package:define-package :asdf/system
     6892(uiop/package:define-package :asdf/system
    68896893  (:recycle :asdf :asdf/system)
    68906894  (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/component)
    69146918  (defgeneric component-entry-point (component))
    69156919  (defmethod component-entry-point ((c component))
    6916     (declare (ignorable c))
    69176920    nil))
    69926995  (defmethod component-build-pathname ((c component))
    6993     (declare (ignorable c))
    69946996    nil))
    69976999;;;; Stamp cache
    6999 (asdf/package:define-package :asdf/cache
     7001(uiop/package:define-package :asdf/cache
    70007002  (:use :uiop/common-lisp :uiop :asdf/upgrade)
    70017003  (:export #:get-file-stamp #:compute-file-stamp #:register-file-stamp
    70627064;;;; Finding systems
    7064 (asdf/package:define-package :asdf/find-system
     7066(uiop/package:define-package :asdf/find-system
    70657067  (:recycle :asdf/find-system :asdf)
    70667068  (:use :uiop/common-lisp :uiop :asdf/upgrade
    73087310  (defmethod find-system ((name null) &optional (error-p t))
    7309     (declare (ignorable name))
    73107311    (when error-p
    73117312      (sysdef-error (compatfmt "~@<NIL is not a valid system name~@:>"))))
    74847485;;;; Finding components
    7486 (asdf/package:define-package :asdf/find-component
     7487(uiop/package:define-package :asdf/find-component
    74877488  (:recycle :asdf/find-component :asdf)
    74887489  (:use :uiop/common-lisp :uiop :asdf/upgrade
    75627563    (find-component (find-component c (car name)) (cdr name)))
    7564   (defmethod find-component (base (actual component))
    7565     (declare (ignorable base))
     7565  (defmethod find-component ((base t) (actual component))
    75667566    actual)
    76047604  (defmethod resolve-dependency-combination (component (combinator (eql :feature)) arguments)
    7605     (declare (ignorable combinator))
    76067605    (when (featurep (first arguments))
    76077606      (resolve-dependency-spec component (second arguments))))
    76097608  (defmethod resolve-dependency-combination (component (combinator (eql :version)) arguments)
    7610     (declare (ignorable combinator)) ;; See
    7611     (resolve-dependency-name component (first arguments) (second arguments))))
     7609    (resolve-dependency-name component (first arguments) (second arguments)))) ;; See lp#527788
    76137611;;;; -------------------------------------------------------------------------
    76147612;;;; Operations
    7616 (asdf/package:define-package :asdf/operation
     7614(uiop/package:define-package :asdf/operation
    76177615  (:recycle :asdf/operation :asdf/action :asdf) ;; asdf/action for FEATURE pre 2.31.5.
    76187616  (:use :uiop/common-lisp :uiop :asdf/upgrade)
    76207618   #:operation
    76217619   #:operation-original-initargs #:original-initargs ;; backward-compatibility only. DO NOT USE.
    7622    #:build-op ;; THE generic operation
    76237620   #:*operations* #:make-operation #:find-operation #:feature))
    76247621(in-package :asdf/operation)
    76287625(when-upgrading (:when (find-class 'operation nil))
    7629   (defmethod shared-initialize :after ((o operation) slot-names &rest initargs &key)
    7630     (declare (ignorable o slot-names initargs)) (values)))
     7626  ;; override any obsolete shared-initialize method when upgrading from ASDF2.
     7627  (defmethod shared-initialize :after ((o operation) (slot-names t) &key)
     7628    (values)))
    76327630(with-upgradability ()
    76357633      :initform nil :initarg :original-initargs :accessor operation-original-initargs)))
     7635  ;; Cache a copy of the INITARGS in the ORIGINAL-INITARGS slot, if that slot is not
     7636  ;; already bound.
    76377637  (defmethod initialize-instance :after ((o operation) &rest initargs
    76387638                                         &key force force-not system verbose &allow-other-keys)
    7639     (declare (ignorable force force-not system verbose))
     7639    (declare (ignore force force-not system verbose))
    76407640    (unless (slot-boundp o 'original-initargs)
    76417641      (setf (operation-original-initargs o) initargs)))
    76577657  (defgeneric find-operation (context spec)
    76587658    (:documentation "Find an operation by resolving the SPEC in the CONTEXT"))
    7659   (defmethod find-operation (context (spec operation))
    7660     (declare (ignorable context))
     7659  (defmethod find-operation ((context t) (spec operation))
    76617660    spec)
    76627661  (defmethod find-operation (context (spec symbol))
    76677666  (defmethod operation-original-initargs ((context symbol))
    76687667    (declare (ignorable context))
    7669     nil)
    7671   (defclass build-op (operation) ()))
     7668    nil))
    76747670;;;; -------------------------------------------------------------------------
    76757671;;;; Actions
    7677 (asdf/package:define-package :asdf/action
     7673(uiop/package:define-package :asdf/action
    76787674  (:nicknames :asdf-action)
    76797675  (:recycle :asdf/action :asdf)
    76837679   #:action #:define-convenience-action-methods
    76847680   #:explain #:action-description
    7685    #:downward-operation #:upward-operation #:sideway-operation #:selfward-operation
     7681   #:downward-operation #:upward-operation #:sideway-operation #:selfward-operation #:non-propagating-operation
    76867682   #:component-depends-on
    76877683   #:input-files #:output-files #:output-file #:operation-done-p
    76907686   #:perform #:perform-with-restarts #:retry #:accept
    76917687   #:traverse-actions #:traverse-sub-actions #:required-components ;; in plan
    7692    #:action-path #:find-action #:stamp #:done-p))
     7688   #:action-path #:find-action #:stamp #:done-p
     7689   #:operation-definition-warning #:operation-definition-error ;; condition
     7690   #:build-op ;; THE generic operation
     7691   ))
    76937692(in-package :asdf/action)
    77867785        FIND-COMPONENT in the context of the COMPONENT argument,
    77877786        and means that the component depends on
    7788         <operation> having been performed on each <component>; or
     7787        <operation> having been performed on each <component>;
     7789        [Note: an <operation> is an operation designator -- it can be either an
     7790        operation name or an operation object.  Similarly, a <component> may be
     7791        a component name or a component object.  Also note that, the degenerate
     7792        case of (<operation>) is a no-op.]
     7794      or
    77907796      (FEATURE <feature>), which means that the component depends
    77987804  (defmethod component-depends-on :around ((o operation) (c component))
    77997805    (do-asdf-cache `(component-depends-on ,o ,c)
    7800       (call-next-method)))
    7802   (defmethod component-depends-on ((o operation) (c component))
    7803     (cdr (assoc (type-of o) (component-in-order-to c))))) ; User-specified in-order dependencies
     7806      (call-next-method))))
    78177820E.g. in order for a MODULE to be loaded with LOAD-OP (resp. compiled with COMPILE-OP), all the
    78187821children of the MODULE must have been loaded with LOAD-OP (resp. compiled with COMPILE-OP."))
     7822  (defun downward-operation-depends-on (o c)
     7823    `((,(or (downward-operation o) o) ,@(component-children c))))
    78197824  (defmethod component-depends-on ((o downward-operation) (c parent-component))
    7820     `((,(or (downward-operation o) o) ,@(component-children c)) ,@(call-next-method)))
     7825    `(,@(downward-operation-depends-on o c) ,@(call-next-method)))
    78227827  (defclass upward-operation (operation)
    78327837  ;; For backward-compatibility reasons, a system inherits from module and is a child-component
    78337838  ;; so we must guard against this case. ASDF4: remove that.
     7839  (defun upward-operation-depends-on (o c)
     7840    (if-let (p (component-parent c)) `((,(or (upward-operation o) o) ,p))))
    78347841  (defmethod component-depends-on ((o upward-operation) (c child-component))
    7835     `(,@(if-let (p (component-parent c))
    7836           `((,(or (upward-operation o) o) ,p))) ,@(call-next-method)))
     7842    `(,@(upward-operation-depends-on o c) ,@(call-next-method)))
    78387844  (defclass sideway-operation (operation)
    78467852E.g. in order for a COMPONENT to be prepared for loading or compiling with PREPARE-OP,
    78477853each of its declared dependencies must first be loaded as by LOAD-OP."))
    7848   (defmethod component-depends-on ((o sideway-operation) (c component))
     7854  (defun sideway-operation-depends-on (o c)
    78497855    `((,(or (sideway-operation o) o)
    78507856       ,@(loop :for dep :in (component-sideway-dependencies c)
    7851                :collect (resolve-dependency-spec c dep)))
    7852       ,@(call-next-method)))
     7857               :collect (resolve-dependency-spec c dep)))))
     7858  (defmethod component-depends-on ((o sideway-operation) (c component))
     7859    `(,@(sideway-operation-depends-on o c) ,@(call-next-method)))
    78547861  (defclass selfward-operation (operation)
    78597866I.e., if O is a SELFWARD-OPERATION, and its SELFWARD-OPERATION designates a list of operations L,
    78607867then the action (O . C) of O on component C depends on each (S . C) for S in L.
     7868E.g. before a component may be loaded by LOAD-OP, it must have been compiled by COMPILE-OP.
    78617869A operation-designator designates a singleton list of the designated operation;
    78627870a list of operation-designators designates the list of designated operations;
    7863 NIL is not a valid operation designator in that context.
    7864 E.g. before a component may be loaded by LOAD-OP, it must have been compiled by COMPILE-OP."))
     7871NIL is not a valid operation designator in that context.  Note that any dependency
     7872ordering between the operations in a list of SELFWARD-OPERATION should be specified separately
     7873in the respective operation's COMPONENT-DEPENDS-ON methods so that they be scheduled properly."))
     7874  (defun selfward-operation-depends-on (o c)
     7875    (loop :for op :in (ensure-list (selfward-operation o)) :collect `(,op ,c)))
    78657876  (defmethod component-depends-on ((o selfward-operation) (c component))
    7866     `(,@(loop :for op :in (ensure-list (selfward-operation o))
    7867               :collect `(,op ,c))
    7868       ,@(call-next-method))))
     7877    `(,@(selfward-operation-depends-on o c) ,@(call-next-method)))
     7879  (defclass non-propagating-operation (operation)
     7880    ()
     7881    (:documentation "A NON-PROPAGATING-OPERATION is an operation that propagates
     7882no dependencies whatsoever.  It is supplied in order that the programmer be able
     7883to specify that s/he is intentionally specifying an operation which invokes no
     7888;;; Help programmers catch obsolete OPERATION subclasses
     7890(with-upgradability ()
     7891  (define-condition operation-definition-warning (simple-warning)
     7892    ()
     7893    (:documentation "Warning condition related to definition of obsolete OPERATION objects."))
     7895  (define-condition operation-definition-error (simple-error)
     7896    ()
     7897    (:documentation "Error condition related to definition of incorrect OPERATION objects."))
     7899  (defmethod initialize-instance :before ((o operation) &key)
     7900    ;; build-op is a special case.
     7901    (unless (typep o '(or downward-operation upward-operation sideway-operation
     7902                          selfward-operation non-propagating-operation))
     7903      (warn 'operation-definition-warning
     7904            :format-control
     7905            "No dependency propagating scheme specified for operation class ~S.
     7906The class needs to be updated for ASDF 3.1 and specify appropriate propagation mixins."
     7907            :format-arguments (list (type-of o)))))
     7909  (defmethod initialize-instance :before ((o non-propagating-operation) &key)
     7910    (when (typep o '(or downward-operation upward-operation sideway-operation selfward-operation))
     7911      (error 'operation-definition-error
     7912             :format-control
     7913             "Inconsistent class: ~S
     7914  NON-PROPAGATING-OPERATION is incompatible with propagating operation classes as superclasses."
     7915             :format-arguments
     7916             (list (type-of o)))))
     7918  (defmethod component-depends-on ((o operation) (c component))
     7919    `(;; Normal behavior, to allow user-specified in-order-to dependencies
     7920      ,@(cdr (assoc (type-of o) (component-in-order-to c)))
     7921      ;; For backward-compatibility with ASDF2, any operation that doesn't specify propagation
     7922      ;; or non-propagation through an appropriate mixin will be downward and sideway.
     7923      ,@(unless (typep o '(or downward-operation upward-operation sideway-operation
     7924                              selfward-operation non-propagating-operation))
     7925          `(,@(downward-operation-depends-on o c)
     7926            ,@(sideway-operation-depends-on o c)))))
     7928  (defmethod downward-operation ((o operation)) nil)
     7929  (defmethod sideway-operation ((o operation)) nil))
     7933;;; End of OPERATION class checking
    78817947  (defmethod operation-done-p ((o operation) (c component))
    7882     (declare (ignorable o c))
    78837948    t)
    79027967       t)))
    79037968  (defmethod output-files ((o operation) (c component))
    7904     (declare (ignorable o c))
    79057969    nil)
    79067970  (defun output-file (operation component)
    79177981  (defmethod input-files ((o operation) (c component))
    7918     (declare (ignorable o c))
    79197982    nil)
    79828045    (mark-operation-done o c))
    79838046  (defmethod perform ((o operation) (c parent-component))
    7984     (declare (ignorable o c))
    79858047    nil)
    79868048  (defmethod perform ((o operation) (c source-file))
    80138075;;; Generic build operation
    80148076(with-upgradability ()
     8077  ;; BUILD-OP was intended to be the default "master" operation to invoke on a system in ASDF3
     8078  ;; (LOAD-OP typically serves that function now).
     8079  ;; This feature has not yet been fully implemented yet, and is not used by anyone yet.
     8080  ;; This is a path forward, and its default below is to backward compatibly depend on LOAD-OP.
     8081  ;; [2014/01/26:rpg]
     8082  (defclass build-op (non-propagating-operation) ())
    80158083  (defmethod component-depends-on ((o build-op) (c component))
    80168084    `((,(or (component-build-operation c) 'load-op) ,c))))
    80198087;;;; Actions to build Common Lisp software
    8021 (asdf/package:define-package :asdf/lisp-action
     8089(uiop/package:define-package :asdf/lisp-action
    80228090  (:recycle :asdf/lisp-action :asdf)
    80238091  (:intern #:proclamations #:flags)
    80568124(with-upgradability ()
    80578125  (defclass prepare-op (upward-operation sideway-operation)
    8058     ((sideway-operation :initform 'load-op :allocation :class)))
    8059   (defclass load-op (basic-load-op downward-operation sideway-operation selfward-operation)
     8126    ((sideway-operation :initform 'load-op :allocation :class))
     8127    (:documentation "Load dependencies necessary for COMPILE-OP or LOAD-OP of a given COMPONENT."))
     8128  (defclass load-op (basic-load-op downward-operation selfward-operation)
    80608129    ;; NB: even though compile-op depends on prepare-op it is not needed-in-image-p,
    80618130    ;; so we need to directly depend on prepare-op for its side-effects in the current image.
    80628131    ((selfward-operation :initform '(prepare-op compile-op) :allocation :class)))
    80638132  (defclass compile-op (basic-compile-op downward-operation selfward-operation)
    8064     ((selfward-operation :initform 'prepare-op :allocation :class)
    8065      (downward-operation :initform 'load-op :allocation :class)))
     8133    ((selfward-operation :initform 'prepare-op :allocation :class)))
    80678135  (defclass prepare-source-op (upward-operation sideway-operation)
    80798147(with-upgradability ()
    80808148  (defmethod action-description ((o prepare-op) (c component))
    8081     (declare (ignorable o))
    80828149    (format nil (compatfmt "~@<loading dependencies of ~3i~_~A~@:>") c))
    80838150  (defmethod perform ((o prepare-op) (c component))
    8084     (declare (ignorable o c))
    8085     nil)
    8086   (defmethod input-files ((o prepare-op) (c component))
    8087     (declare (ignorable o c))
    80888151    nil)
    80898152  (defmethod input-files ((o prepare-op) (s system))
    8090     (declare (ignorable o))
    80918153    (if-let (it (system-source-file s)) (list it))))
    80948156(with-upgradability ()
    80958157  (defmethod action-description ((o compile-op) (c component))
    8096     (declare (ignorable o))
    80978158    (format nil (compatfmt "~@<compiling ~3i~_~A~@:>") c))
    80988159  (defmethod action-description ((o compile-op) (c parent-component))
    8099     (declare (ignorable o))
    81008160    (format nil (compatfmt "~@<completing compilation for ~3i~_~A~@:>") c))
    81018161  (defgeneric call-with-around-compile-hook (component thunk))
    81638223    (lisp-compilation-output-files o c))
    81648224  (defmethod perform ((o compile-op) (c static-file))
    8165     (declare (ignorable o c))
    8166     nil)
    8167   (defmethod output-files ((o compile-op) (c static-file))
    8168     (declare (ignorable o c))
    81698225    nil)
    81708226  (defmethod perform ((o compile-op) (c system))
    81868242(with-upgradability ()
    81878243  (defmethod action-description ((o load-op) (c cl-source-file))
    8188     (declare (ignorable o))
    81898244    (format nil (compatfmt "~@<loading FASL for ~3i~_~A~@:>") c))
    81908245  (defmethod action-description ((o load-op) (c parent-component))
    8191     (declare (ignorable o))
    81928246    (format nil (compatfmt "~@<completing load for ~3i~_~A~@:>") c))
    8193   (defmethod action-description ((o load-op) component)
    8194     (declare (ignorable o))
    8195     (format nil (compatfmt "~@<loading ~3i~_~A~@:>")
    8196             component))
     8247  (defmethod action-description ((o load-op) (c component))
     8248    (format nil (compatfmt "~@<loading ~3i~_~A~@:>") c))
    81978249  (defmethod perform-with-restarts ((o load-op) (c cl-source-file))
    81988250    (loop
    82108262    (perform-lisp-load-fasl o c))
    82118263  (defmethod perform ((o load-op) (c static-file))
    8212     (declare (ignorable o c))
    82138264    nil))
    82198270(with-upgradability ()
    82208271  (defmethod action-description ((o prepare-source-op) (c component))
    8221     (declare (ignorable o))
    82228272    (format nil (compatfmt "~@<loading source for dependencies of ~3i~_~A~@:>") c))
    8223   (defmethod input-files ((o prepare-source-op) (c component))
    8224     (declare (ignorable o c))
    8225     nil)
    82268273  (defmethod input-files ((o prepare-source-op) (s system))
    8227     (declare (ignorable o))
    82288274    (if-let (it (system-source-file s)) (list it)))
    82298275  (defmethod perform ((o prepare-source-op) (c component))
    8230     (declare (ignorable o c))
    82318276    nil))
    82338278;;; load-source-op
    82348279(with-upgradability ()
    8235   (defmethod action-description ((o load-source-op) c)
    8236     (declare (ignorable o))
     8280  (defmethod action-description ((o load-source-op) (c component))
    82378281    (format nil (compatfmt "~@<Loading source of ~3i~_~A~@:>") c))
    82388282  (defmethod action-description ((o load-source-op) (c parent-component))
    8239     (declare (ignorable o))
    82408283    (format nil (compatfmt "~@<Loaded source of ~3i~_~A~@:>") c))
    82418284  (defun perform-lisp-load-source (o c)
    82488291    (perform-lisp-load-source o c))
    82498292  (defmethod perform ((o load-source-op) (c static-file))
    8250     (declare (ignorable o c))
    8251     nil)
    8252   (defmethod output-files ((o load-source-op) (c component))
    8253     (declare (ignorable o c))
    82548293    nil))
    82588297(with-upgradability ()
    82598298  (defmethod perform ((o test-op) (c component))
    8260     (declare (ignorable o c))
    82618299    nil)
    82628300  (defmethod operation-done-p ((o test-op) (c system))
    82638301    "Testing a system is _never_ done."
    8264     (declare (ignorable o c))
    82658302    nil))
    82688305;;;; Plan
    8270 (asdf/package:define-package :asdf/plan
     8307(uiop/package:define-package :asdf/plan
    82718308  (:recycle :asdf/plan :asdf)
    82728309  (:use :uiop/common-lisp :uiop :asdf/upgrade
    83358372        (format stream "~@{~S~^ ~}" :stamp stamp :done-p done-p :planned-p planned-p :index index))))
    8337   (defmethod action-planned-p (action-status)
    8338     (declare (ignorable action-status)) ; default method for non planned-action-status objects
    8339     t)
     8374  (defmethod action-planned-p ((action-status t))
     8375    t) ; default method for non planned-action-status objects
    83418377  ;; TODO: eliminate NODE-FOR, use CONS.
    83498385  (defmethod plan-action-status ((plan null) (o operation) (c component))
    8350     (declare (ignorable plan))
    83518386    (multiple-value-bind (stamp done-p) (component-operation-time o c)
    83528387      (make-instance 'action-status :stamp stamp :done-p done-p)))
    83548389  (defmethod (setf plan-action-status) (new-status (plan null) (o operation) (c component))
    8355     (declare (ignorable plan))
    83568390    (let ((to (type-of o))
    83578391          (times (component-operation-times c)))
    83758409  (defun action-override-p (plan operation component override-accessor)
    8376     (declare (ignorable operation))
     8410    (declare (ignore operation))
    83778411    (let* ((override (funcall override-accessor plan)))
    83788412      (and override
    83988432     (not (action-forced-p plan operation component))))
    8400   (defmethod action-forced-p ((plan null) operation component)
    8401     (declare (ignorable plan operation component))
     8434  (defmethod action-forced-p ((plan null) (operation operation) (component component))
    84028435    nil)
    8404   (defmethod action-forced-not-p ((plan null) operation component)
    8405     (declare (ignorable plan operation component))
     8437  (defmethod action-forced-not-p ((plan null) (operation operation) (component component))
    84068438    nil))
    84118443  (defgeneric action-valid-p (plan operation component)
    84128444    (:documentation "Is this action valid to include amongst dependencies?"))
    8413   (defmethod action-valid-p (plan operation (c component))
    8414     (declare (ignorable plan operation))
     8445  (defmethod action-valid-p ((plan plan-traversal) (o operation) (c component))
    84158446    (if-let (it (component-if-feature c)) (featurep it) t))
    8416   (defmethod action-valid-p (plan (o null) c) (declare (ignorable plan o c)) nil)
    8417   (defmethod action-valid-p (plan o (c null)) (declare (ignorable plan o c)) nil)
    8418   (defmethod action-valid-p ((plan null) operation component)
    8419     (declare (ignorable plan operation component))
    8420     (and operation component t)))
     8447  (defmethod action-valid-p ((plan t) (o null) (c t)) nil)
     8448  (defmethod action-valid-p ((plan t) (o t) (c null)) nil)
     8449  (defmethod action-valid-p ((plan null) (o operation) (c component)) t))
    84568485    (reduce-direct-dependencies operation component #'acons nil))
     8487  ;; In a distant future, get-file-stamp, component-operation-time and latest-stamp
     8488  ;; shall also be parametrized by the plan, or by a second model object,
     8489  ;; so they need not refer to the state of the filesystem,
     8490  ;; and the stamps could be cryptographic checksums rather than timestamps.
     8491  ;; Such a change remarkably would only affect VISIT-DEPENDENCIES and COMPUTE-ACTION-STAMP.
    84588493  (defun visit-dependencies (plan operation component dependency-stamper &aux stamp)
    84598494    (map-direct-dependencies
    84668501  (defmethod compute-action-stamp (plan (o operation) (c component) &key just-done)
    8467     ;; In a distant future, get-file-stamp and component-operation-time
    8468     ;; shall also be parametrized by the plan, or by a second model object.
     8502    ;; Given an action, figure out at what time in the past it has been done,
     8503    ;; or if it has just been done, return the time that it has.
     8504    ;; Returns two values:
     8505    ;; 1- the TIMESTAMP of the action if it has already been done and is up to date,
     8506    ;;   or T is either hasn't been done or is out of date.
     8507    ;; 2- the DONE-IN-IMAGE-P boolean flag that is T if the action has already been done
     8508    ;;   in the current image, or NIL if it hasn't.
     8509    ;; Note that if e.g. LOAD-OP only depends on up-to-date files, but
     8510    ;; hasn't been done in the current image yet, then it can have a non-T timestamp,
     8511    ;; yet a NIL done-in-image-p flag.
    84698512    (let* ((stamp-lookup #'(lambda (o c)
    84708513                             (if-let (it (plan-action-status plan o c)) (action-stamp it) t)))
    85678610  (defgeneric traverse-action (plan operation component needed-in-image-p))
     8612  ;; TRAVERSE-ACTION, in the context of a given PLAN object that accumulates dependency data,
     8613  ;; visits the action defined by its OPERATION and COMPONENT arguments,
     8614  ;; and all its transitive dependencies (unless already visited),
     8615  ;; in the context of the action being (or not) NEEDED-IN-IMAGE-P,
     8616  ;; i.e. needs to be done in the current image vs merely have been done in a previous image.
     8617  ;; For actions that are up-to-date, it returns a STAMP identifying the state of the action
     8618  ;; (that's timestamp, but it could be a cryptographic digest in some ASDF extension),
     8619  ;; or T if the action needs to be done again.
     8620  ;;
     8621  ;; Note that for an XCVB-like plan with one-image-per-file-outputting-action,
     8622  ;; the below method would be insufficient, since it assumes a single image
     8623  ;; to traverse each node at most twice; non-niip actions would be traversed only once,
     8624  ;; but niip nodes could be traversed once per image, i.e. once plus once per non-niip action.
    85698626  (defmethod traverse-action (plan operation component needed-in-image-p)
    85708627    (block nil
     8628      ;; ACTION-VALID-P among other things, handles forcing logic, including FORCE-NOT,
     8629      ;; and IF-FEATURE filtering.
    85718630      (unless (action-valid-p plan operation component) (return nil))
     8631      ;; the following hook is needed by POIU, which tracks a full dependency graph,
     8632      ;; instead of just a dependency order as in vanilla ASDF
    85728633      (plan-record-dependency plan operation component)
    8573       (let* ((aniip (needed-in-image-p operation component))
     8634      ;; needed in image distinguishes b/w things that must happen in the
     8635      ;; current image and those things that simply need to have been done in a previous one.
     8636      (let* ((aniip (needed-in-image-p operation component)) ; action-specific needed-in-image
     8637             ;; effective niip: meaningful for the action and required by the plan as traversed
    85748638             (eniip (and aniip needed-in-image-p))
     8639             ;; status: have we traversed that action previously, and if so what was its status?
    85758640             (status (plan-action-status plan operation component)))
    85768641        (when (and status (or (action-done-p status) (action-planned-p status) (not eniip)))
    8577           ;; Already visited with sufficient need-in-image level: just return the stamp.
    8578           (return (action-stamp status)))
    8579         (labels ((visit-action (niip)
    8580                    (visit-dependencies plan operation component
     8642          (return (action-stamp status))) ; Already visited with sufficient need-in-image level!
     8643        (labels ((visit-action (niip) ; We may visit the action twice, once with niip NIL, then T
     8644                   (visit-dependencies plan operation component ; recursively traverse dependencies
    85818645                                       #'(lambda (o c) (traverse-action plan o c niip)))
    8582                    (multiple-value-bind (stamp done-p)
    8583                        (compute-action-stamp plan operation component)
     8646                   (multiple-value-bind (stamp done-p) ; AFTER dependencies have been traversed,
     8647                       (compute-action-stamp plan operation component) ; compute action stamp
    85848648                     (let ((add-to-plan-p (or (eql stamp t) (and niip (not done-p)))))
    8585                        (cond
    8586                          ((and add-to-plan-p (not niip)) ;; if we need to do it,
    8587                           (visit-action t)) ;; then we need to do it in the image!
     8649                       (cond ; it needs be done if it's out of date or needed in image but absent
     8650                         ((and add-to-plan-p (not niip)) ; if we need to do it,
     8651                          (visit-action t)) ; then we need to do it *in the (current) image*!
    85888652                         (t
    8589                           (setf (plan-action-status plan operation component)
     8653                          (setf (plan-action-status plan operation component) ; update status:
    85908654                                (make-instance
    85918655                                 'planned-action-status
    8592                                  :stamp stamp
    8593                                  :done-p (and done-p (not add-to-plan-p))
    8594                                  :planned-p add-to-plan-p
    8595                                  :index (if status
    8596                                             (action-index status)
    8597                                             (incf (plan-total-action-count plan)))))
    8598                           (when add-to-plan-p
    8599                             (incf (plan-planned-action-count plan))
    8600                             (unless aniip
    8601                               (incf (plan-planned-output-action-count plan))))
    8602                           stamp))))))
     8656                                 :stamp stamp ; computed stamp
     8657                                 :done-p (and done-p (not add-to-plan-p)) ; done *and* up-to-date?
     8658                                 :planned-p add-to-plan-p ; included in list of things to be done?
     8659                                 :index (if status ; index of action amongst all nodes in traversal
     8660                                            (action-index status) ;; if already visited, keep index
     8661                                            (incf (plan-total-action-count plan))))) ; else new index
     8662                          (when add-to-plan-p ; if it needs to be added to the plan,
     8663                            (incf (plan-planned-action-count plan)) ; count it
     8664                            (unless aniip ; if it's output-producing,
     8665                              (incf (plan-planned-output-action-count plan)))) ; count it
     8666                          stamp)))))) ; return the stamp
    86038667          (while-visiting-action (plan operation component) ; maintain context, handle circularity.
    8604             (visit-action eniip)))))))
     8668            (visit-action eniip))))))) ; visit the action
    86168680    (reverse (plan-actions-r plan)))
    8618   (defmethod plan-record-dependency ((plan sequential-plan)
    8619                                      (operation operation) (component component))
    8620     (declare (ignorable plan operation component))
     8682  (defmethod plan-record-dependency ((plan sequential-plan) (o operation) (c component))
    86218683    (values))
    86708732;;;; Incidental traversals
     8734;;; Making a FILTERED-SEQUENTIAL-PLAN can be used to, e.g., all of the source
     8735;;; files required by a bundling operation.
    86718736(with-upgradability ()
    86728737  (defclass filtered-sequential-plan (sequential-plan)
    87168781;;;; Invoking Operations
    8718 (asdf/package:define-package :asdf/operate
     8783(uiop/package:define-package :asdf/operate
    87198784  (:recycle :asdf/operate :asdf)
    87208785  (:use :uiop/common-lisp :uiop :asdf/upgrade
    873888031. It creates an instance of OPERATION-CLASS using any keyword parameters as initargs.
    873988042. It finds the  asdf-system specified by SYSTEM (possibly loading it from disk).
    8740 3. It then calls TRAVERSE with the operation and system as arguments
    8742 The traverse operation is wrapped in WITH-COMPILATION-UNIT and error handling code.
    8743 If a VERSION argument is supplied, then operate also ensures that the system found
    8744 satisfies it using the VERSION-SATISFIES method.
     88053. It then calls MAKE-PLAN with the operation and system as arguments
     8807The operation of making a plan is wrapped in WITH-COMPILATION-UNIT and error
     8808handling code.  If a VERSION argument is supplied, then operate also ensures
     8809that the system found satisfies it using the VERSION-SATISFIES method.
    87468811Note that dependencies may cause the operation to invoke other operations on the system
    87688833                                (on-warnings *compile-file-warnings-behaviour*)
    87698834                                (on-failure *compile-file-failure-behaviour*) &allow-other-keys)
    8770     (declare (ignorable operation component))
    87718835    (let* ((systems-being-operated *systems-being-operated*)
    87728836           (*systems-being-operated* (or systems-being-operated (make-hash-table :test 'equal)))
    88768940  (defmethod perform ((o compile-op) (c require-system))
    8877     (declare (ignorable o c))
    88788941    nil)
    88808943  (defmethod perform ((o load-op) (s require-system))
    8881     (declare (ignorable o))
    88828944    (let* ((module (or (required-module s) (coerce-name s)))
    88838945           (*modules-being-required* (cons module *modules-being-required*)))
    88878949  (defmethod resolve-dependency-combination (component (combinator (eql :require)) arguments)
    8888     (declare (ignorable component combinator))
    88898950    (unless (length=n-p arguments 1)
    88908951      (error (compatfmt "~@<Bad dependency ~S for ~S. ~S takes only one argument~@:>")
    89348995;;;; asdf-output-translations
    8936 (asdf/package:define-package :asdf/output-translations
     8997(uiop/package:define-package :asdf/output-translations
    89378998  (:recycle :asdf/output-translations :asdf)
    89388999  (:use :uiop/common-lisp :uiop :asdf/upgrade)
    91559216                                 :inherit inherit :collect collect))
    91569217  (defmethod process-output-translations ((x null) &key inherit collect)
    9157     (declare (ignorable x))
    91589218    (inherit-output-translations inherit :collect collect))
    91599219  (defmethod process-output-translations ((form cons) &key inherit collect)
    92479307;;;; See the Manual and
    9249 (asdf/package:define-package :asdf/source-registry
     9309(uiop/package:define-package :asdf/source-registry
    92509310  (:recycle :asdf/source-registry :asdf)
    92519311  (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/find-system)
    94809540                             :inherit inherit :register register))
    94819541  (defmethod process-source-registry ((x null) &key inherit register)
    9482     (declare (ignorable x))
    94839542    (inherit-source-registry inherit :register register))
    94849543  (defmethod process-source-registry ((form cons) &key inherit register)
    95619620;;; Internal hacks for backward-compatibility
    9563 (asdf/package:define-package :asdf/backward-internals
     9622(uiop/package:define-package :asdf/backward-internals
    95649623  (:recycle :asdf/backward-internals :asdf)
    95659624  (:use :uiop/common-lisp :uiop :asdf/upgrade
    96519710;;;; Defsystem
    9653 (asdf/package:define-package :asdf/parse-defsystem
     9712(uiop/package:define-package :asdf/parse-defsystem
    96549713  (:recycle :asdf/parse-defsystem :asdf/defsystem :asdf)
    96559714  (:nicknames :asdf/defsystem) ;; previous name, to be compatible with, in case anyone cares
    97939852                                ;; list ends
    97949853         &allow-other-keys) options
    9795       (declare (ignorable perform explain output-files operation-done-p builtin-system-p))
     9854      (declare (ignore perform explain output-files operation-done-p builtin-system-p))
    97969855      (check-component-input type name weakly-depends-on depends-on components)
    97979856      (when (and parent
    98929951;;;; ASDF-Bundle
    9894 (asdf/package:define-package :asdf/bundle
     9953(uiop/package:define-package :asdf/bundle
    98959954  (:recycle :asdf/bundle :asdf)
    98969955  (:use :uiop/common-lisp :uiop :asdf/upgrade
    994210001  (defclass no-ld-flags-op (operation) ())
    9944   (defclass lib-op (bundle-compile-op no-ld-flags-op)
     10003  (defclass lib-op (bundle-compile-op no-ld-flags-op non-propagating-operation)
    994510004    ((bundle-type :initform #+(or ecl mkcl) :lib #-(or ecl mkcl) :no-output-file))
    994610005    (:documentation #+(or ecl mkcl) "compile the system and produce linkable (.a) library for it."
    994710006     #-(or ecl mkcl) "just compile the system"))
    9949   (defclass dll-op (bundle-compile-op no-ld-flags-op)
     10008  (defclass dll-op (bundle-compile-op no-ld-flags-op non-propagating-operation)
    995010009    ((bundle-type :initform :dll))
    995110010    (:documentation "compile the system and produce dynamic (.so/.dll) library for it."))
    995510014    (:documentation "produce fasl and asd files for the system"))
    9957   (defclass monolithic-op (operation) ()) ;; operation on a system and its dependencies
     10016  (defclass monolithic-op (operation) ()
     10017    (:documentation "A MONOLITHIC operation operates on a system *and all of its
     10018dependencies*.  So, for example, a monolithic concatenate operation will
     10019concatenate together a system's components and all of its dependencies, but a
     10020simple concatenate operation will concatenate only the components of the system
     10021itself.")) ;; operation on a system and its dependencies
    995910023  (defclass monolithic-bundle-op (monolithic-op bundle-op)
    996310027  (defclass monolithic-bundle-compile-op (monolithic-bundle-op bundle-compile-op)
    996410028    ()
    9965     (:documentation "Abstract operation for ways to bundle the outputs of compiling *Lisp* files over all systems"))
     10029    (:documentation "Abstract operation for ways to bundle the outputs of compiling
     10030*Lisp* files over a system, and all of its dependencies."))
    996710032  (defclass monolithic-binary-op (monolithic-op binary-op)
    996910034    (:documentation "produce fasl and asd files for combined system and dependencies."))
    9971   (defclass monolithic-fasl-op (monolithic-bundle-compile-op basic-fasl-op) ()
     10036  (defclass monolithic-fasl-op (monolithic-bundle-compile-op basic-fasl-op non-propagating-operation) ()
    997210037    (:documentation "Create a single fasl for the system and its dependencies."))
    9974   (defclass monolithic-lib-op (monolithic-bundle-compile-op basic-compile-op no-ld-flags-op)
     10039  (defclass monolithic-lib-op (monolithic-bundle-compile-op non-propagating-operation no-ld-flags-op)
    997510040    ((bundle-type :initform #+(or ecl mkcl) :lib #-(or ecl mkcl) :no-output-file))
    997610041    (:documentation #+(or ecl mkcl) "Create a single linkable library for the system and its dependencies."
    997710042     #-(or ecl mkcl) "Compile a system and its dependencies."))
    9979   (defclass monolithic-dll-op (monolithic-bundle-compile-op sideway-operation selfward-operation no-ld-flags-op)
     10044  (defclass monolithic-dll-op (monolithic-bundle-compile-op non-propagating-operation no-ld-flags-op)
    998010045    ((bundle-type :initform :dll))
    998110046    (:documentation "Create a single dynamic (.so/.dll) library for the system and its dependencies."))
    9983   (defclass program-op #+(or mkcl ecl) (monolithic-bundle-compile-op)
     10048  ;; Fare reports that the PROGRAM-OP doesn't need any propagation on MKCL or
     10049  ;; ECL because the necessary dependency wrangling is done by other, earlier
     10050  ;; operations. [2014/01/20:rpg]
     10051  (defclass program-op #+(or mkcl ecl) (monolithic-bundle-compile-op non-propagating-operation)
    998410052            #-(or mkcl ecl) (monolithic-bundle-op selfward-operation)
    998510053    ((bundle-type :initform :program)
    9986      #-(or mkcl ecl) (selfward-operation :initform #-(or mkcl ecl) 'load-op))
     10054     #-(or mkcl ecl) (selfward-operation :initform 'load-op))
    998710055    (:documentation "create an executable file from the system and its dependencies"))
    1004510113                                         &key (name-suffix nil name-suffix-p)
    1004610114                                         &allow-other-keys)
    10047     (declare (ignorable initargs name-suffix))
     10115    (declare (ignore initargs name-suffix))
    1004810116    (unless name-suffix-p
    1004910117      (setf (slot-value instance 'name-suffix)
    1006710135  (defmethod bundle-op-build-args :around ((o no-ld-flags-op))
    10068     (declare (ignorable o))
    1006910136    (let ((args (call-next-method)))
    1007010137      (remf args :ld-flags)
    1011210179  (defmethod component-depends-on :around ((o bundle-op) (c component))
    10113     (declare (ignorable o c))
    1011410180    (if-let (op (and (eq (type-of o) 'bundle-op) (component-build-operation c)))
    1011510181      `((,op ,c))
    1017310239(with-upgradability ()
    1017410240  (defmethod component-depends-on ((o load-fasl-op) (c system))
    10175     (declare (ignorable o))
    1017610241    `((,o ,@(loop :for dep :in (component-sideway-dependencies c)
    1017710242                  :collect (resolve-dependency-spec c dep)))
    1018210247    (when (user-system-p c)
    1018310248      (output-files (find-operation o 'fasl-op) c)))
    10185   (defmethod perform ((o load-fasl-op) c)
    10186     (declare (ignorable o c))
    10187     nil)
    1018910250  (defmethod perform ((o load-fasl-op) (c system))
    1020410265    (every #'(lambda (c) (typep c 'compiled-file)) (component-children s)))
    10206   (defmethod output-files (o (c compiled-file))
    10207     (declare (ignorable o c))
    10208     nil)
    10209   (defmethod input-files (o (c compiled-file))
    10210     (declare (ignorable o))
     10267  (defmethod input-files ((o operation) (c compiled-file))
    1021110268    (component-pathname c))
    1021210269  (defmethod perform ((o load-op) (c compiled-file))
    1021710274    (perform (find-operation o 'load-op) c))
    1021810275  (defmethod perform ((o operation) (c compiled-file))
    10219     (declare (ignorable o c))
    1022010276    nil))
    1022510281(with-upgradability ()
    1022610282  (defmethod trivial-system-p ((s prebuilt-system))
    10227     (declare (ignorable s))
    1022810283    t)
    1023010285  (defmethod perform ((o lib-op) (c prebuilt-system))
    10231     (declare (ignorable o c))
    1023210286    nil)
    1023410288  (defmethod component-depends-on ((o lib-op) (c prebuilt-system))
    10235     (declare (ignorable o c))
    1023610289    nil)
    1023810291  (defmethod component-depends-on ((o monolithic-lib-op) (c prebuilt-system))
    10239     (declare (ignorable o))
    1024010292    nil))
    1031110363  (defmethod input-files ((o load-op) (s precompiled-system))
    10312     (declare (ignorable o))
    1031310364    (bundle-output-files (find-operation o 'fasl-op) s))
    1031810369  (defmethod component-depends-on ((o load-fasl-op) (s precompiled-system))
    10319     (declare (ignorable o))
    1032010370    `((load-op ,s) ,@(call-next-method))))
    1038110431    (declare (ignore force verbose version))
    1038210432    (apply #'operate 'binary-op system args)))
     10434#+(and (not asdf-use-unsafe-mac-bundle-op)
     10435       (or (and ecl darwin)
     10436           (and abcl darwin (not abcl-bundle-op-supported))))
     10437(defmethod perform :before ((o basic-fasl-op) (c component))
     10438  (unless (featurep :asdf-use-unsafe-mac-bundle-op)
     10439    (cerror "Continue after modifying *FEATURES*."
     10440            "BASIC-FASL-OP bundle operations are not supported on Mac OS X for this lisp.~%~T~
     10441To continue, push :asdf-use-unsafe-mac-bundle-op onto *FEATURES*.~%~T~
     10442Please report to ASDF-DEVEL if this works for you.")))
    1038310443;;;; -------------------------------------------------------------------------
    1038410444;;;; Concatenate-source
    10386 (asdf/package:define-package :asdf/concatenate-source
     10446(uiop/package:define-package :asdf/concatenate-source
    1038710447  (:recycle :asdf/concatenate-source :asdf)
    1038810448  (:use :uiop/common-lisp :uiop :asdf/upgrade
    1041110471  (defclass basic-load-compiled-concatenated-source-op (basic-load-op selfward-operation) ())
    10413   (defclass concatenate-source-op (basic-concatenate-source-op) ())
     10473  (defclass concatenate-source-op (basic-concatenate-source-op non-propagating-operation) ())
    1041410474  (defclass load-concatenated-source-op (basic-load-concatenated-source-op)
    1041510475    ((selfward-operation :initform '(prepare-op concatenate-source-op) :allocation :class)))
    1041910479    ((selfward-operation :initform '(prepare-op compile-concatenated-source-op) :allocation :class)))
    10421   (defclass monolithic-concatenate-source-op (basic-concatenate-source-op monolithic-bundle-op) ())
     10481  (defclass monolithic-concatenate-source-op (basic-concatenate-source-op monolithic-bundle-op non-propagating-operation) ())
    1042210482  (defclass monolithic-load-concatenated-source-op (basic-load-concatenated-source-op)
    1042310483    ((selfward-operation :initform 'monolithic-concatenate-source-op :allocation :class)))
    1047310533;;; Backward-compatible interfaces
    10475 (asdf/package:define-package :asdf/backward-interface
     10535(uiop/package:define-package :asdf/backward-interface
    1047610536  (:recycle :asdf/backward-interface :asdf)
    1047710537  (:use :uiop/common-lisp :uiop :asdf/upgrade
    1051510575  (defgeneric (setf operation-on-failure) (x operation))
    1051610576  (defmethod operation-on-warnings ((o operation))
    10517     (declare (ignorable o)) *compile-file-warnings-behaviour*)
     10577    *compile-file-warnings-behaviour*)
    1051810578  (defmethod operation-on-failure ((o operation))
    10519     (declare (ignorable o)) *compile-file-failure-behaviour*)
     10579    *compile-file-failure-behaviour*)
    1052010580  (defmethod (setf operation-on-warnings) (x (o operation))
    10521     (declare (ignorable o)) (setf *compile-file-warnings-behaviour* x))
     10581    (setf *compile-file-warnings-behaviour* x))
    1052210582  (defmethod (setf operation-on-failure) (x (o operation))
    10523     (declare (ignorable o)) (setf *compile-file-failure-behaviour* x))
     10583    (setf *compile-file-failure-behaviour* x))
    1052510585  (defun system-definition-pathname (x)
    1059210652  (defmethod operate :before (operation-class system &rest args &key &allow-other-keys)
    10593     (declare (ignorable operation-class system args))
     10653    (declare (ignore operation-class system args))
    1059410654    (when (find-symbol* '#:output-files-for-system-and-operation :asdf nil)
    1059510655      (error "ASDF 2 is not compatible with ASDF-BINARY-LOCATIONS, which you are using.
    1077210832;;;; Handle ASDF package upgrade, including implementation-dependent magic.
    10774 (asdf/package:define-package :asdf/interface
     10834(uiop/package:define-package :asdf/interface
    1077510835  (:nicknames :asdf :asdf-utilities)
    1077610836  (:recycle :asdf/interface :asdf)
    1079710857   #:operation #:make-operation #:find-operation
    1079810858   #:upward-operation #:downward-operation #:sideway-operation #:selfward-operation
     10859                      #:non-propagating-operation
    1079910860   #:build-system #:build-op
    1080010861   #:load-op #:prepare-op #:compile-op
    1089110952   #:duplicate-names #:non-toplevel-system #:non-system-system
    1089210953   #:package-system-missing-package-error
     10954   #:operation-definition-warning #:operation-definition-error
    1089410956   #:try-recompiling
    1093710999;;;; ASDF-USER, where the action happens.
    10939 (asdf/package:define-package :asdf/user
     11001(uiop/package:define-package :asdf/user
    1094011002  (:nicknames :asdf-user)
    10941   (:use :asdf/common-lisp :asdf/package :asdf/interface))
     11003  ;; TODO: it would be nice to have :UIOP in the list,
     11004  ;; but we need test compatibility with cl-test-grid first.
     11005  (:use :uiop/common-lisp :uiop/package :asdf/interface))
    1094211006;;;; -----------------------------------------------------------------------
    1094311007;;;; ASDF Footer: last words and cleanup
    10945 (asdf/package:define-package :asdf/footer
     11009(uiop/package:define-package :asdf/footer
    1094611010  (:recycle :asdf/footer :asdf)
    1094711011  (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/operate :asdf/bundle))
Note: See TracChangeset for help on using the changeset viewer.