Changeset 14626


Ignore:
Timestamp:
02/12/14 19:11:06 (8 years ago)
Author:
Mark Evenson
Message:

asdf 3.1.0.65: restores BUNDLE-OP as working.

Location:
trunk/abcl
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/doc/asdf/asdf.texinfo

    r14604 r14626  
    3636@url{http://common-lisp.net/project/asdf/asdf.html}.
    3737
    38 ASDF Copyright @copyright{} 2001-2013 Daniel Barlow and contributors.
    39 
    40 This manual Copyright @copyright{} 2001-2013 Daniel Barlow and contributors.
    41 
    42 This manual revised @copyright{} 2009-2013 Robert P. Goldman and Francois-Rene Rideau.
     38ASDF Copyright @copyright{} 2001-2014 Daniel Barlow and contributors.
     39
     40This manual Copyright @copyright{} 2001-2014 Daniel Barlow and contributors.
     41
     42This manual revised @copyright{} 2009-2014 Robert P. Goldman and Francois-Rene Rideau.
    4343
    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 3.1.0.49: Another System Definition Facility.
     1;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-
     2;;; This is ASDF 3.1.0.65: Another System Definition Facility.
    33;;;
    44;;; Feedback, bug reports, and patches are all welcome:
     
    5454  (setf ext:*gc-verbose* nil))
    5555
     56;;; pre 1.3.0 ABCL versions do not support the bundle-op on Mac OS X
     57#+abcl
     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*)))
     62
    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))
     2874
    28542875
    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)))))))))
    28802906
    28812907  (defun subdirectories (directory)
     
    45774603
    45784604  (defmethod slurp-input-stream ((x (eql 'string)) stream &key stripped)
    4579     (declare (ignorable x))
    45804605    (slurp-stream-string stream :stripped stripped))
    45814606
    45824607  (defmethod slurp-input-stream ((x (eql :string)) stream &key stripped)
    4583     (declare (ignorable x))
    45844608    (slurp-stream-string stream :stripped stripped))
    45854609
    45864610  (defmethod slurp-input-stream ((x (eql :lines)) stream &key count)
    4587     (declare (ignorable x))
    45884611    (slurp-stream-lines stream :count count))
    45894612
    45904613  (defmethod slurp-input-stream ((x (eql :line)) stream &key (at 0))
    4591     (declare (ignorable x))
    45924614    (slurp-stream-line stream :at at))
    45934615
    45944616  (defmethod slurp-input-stream ((x (eql :forms)) stream &key count)
    4595     (declare (ignorable x))
    45964617    (slurp-stream-forms stream :count count))
    45974618
    45984619  (defmethod slurp-input-stream ((x (eql :form)) stream &key (at 0))
    4599     (declare (ignorable x))
    46004620    (slurp-stream-form stream :at at))
    46014621
    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))
    46054624
    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)
    46094627
     
    46804698
    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))
    46844701
    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))
    46884704
     
    64196435;; See https://bugs.launchpad.net/asdf/+bug/485687
    64206436
    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)
    64336449
     
    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         ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
    64826500         ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
    6483          (asdf-version "3.1.0.49")
     6501         (asdf-version "3.1.0.65")
    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
    65776594
    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)
    66396656
    66406657  ;; Backward compatible way of computing the FILE-TYPE of a component.
     
    66576674                       (duplicate-names-name c))))))
    66586675
    6659 
    6660 
    6661 (when-upgrading (:when (find-class 'component nil))
    6662   (defmethod reinitialize-instance :after ((c component) &rest initargs &key)
    6663     (declare (ignorable c initargs)) (values)))
    66646676
    66656677(with-upgradability ()
     
    67176729
    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."))
    67386754
    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
     6784children.")))
    67676785
    67686786(with-upgradability ()
     
    67776795                  (setf (gethash name hash) c))
    67786796        hash))))
    6779 
    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))))
    67926797
    67936798(with-upgradability ()
     
    68166821
    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)))
    68286834
    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)
    68326837
    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)))
    68366840
     
    68866890;;;; Systems
    68876891
    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))
    69186921
     
    69916994
    69926995  (defmethod component-build-pathname ((c component))
    6993     (declare (ignorable c))
    69946996    nil))
    69956997
     
    69976999;;;; Stamp cache
    69987000
    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
    70637065
    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
     
    73077309
    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
    74857486
    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)))
    75637564
    7564   (defmethod find-component (base (actual component))
    7565     (declare (ignorable base))
     7565  (defmethod find-component ((base t) (actual component))
    75667566    actual)
    75677567
     
    76037603
    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))))
    76087607
    76097608  (defmethod resolve-dependency-combination (component (combinator (eql :version)) arguments)
    7610     (declare (ignorable combinator)) ;; See https://bugs.launchpad.net/asdf/+bug/527788
    7611     (resolve-dependency-name component (first arguments) (second arguments))))
     7609    (resolve-dependency-name component (first arguments) (second arguments)))) ;; See lp#527788
    76127610
    76137611;;;; -------------------------------------------------------------------------
    76147612;;;; Operations
    76157613
    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)
     
    76277624
    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)))
    76317629
    76327630(with-upgradability ()
     
    76357633      :initform nil :initarg :original-initargs :accessor operation-original-initargs)))
    76367634
     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)
    7670 
    7671   (defclass build-op (operation) ()))
    7672 
     7668    nil))
    76737669
    76747670;;;; -------------------------------------------------------------------------
    76757671;;;; Actions
    76767672
    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)
    76947693
     
    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>;
     7788
     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.]
     7793
     7794      or
    77897795
    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)))
    7801 
    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))))
    78047807
    78057808
     
    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)))
    78217826
    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)))
    78377843
    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)))
    78537860
    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)))
     7878
     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
     7884dependencies.")))
     7885
     7886
     7887;;;---------------------------------------------------------------------------
     7888;;; Help programmers catch obsolete OPERATION subclasses
     7889;;;---------------------------------------------------------------------------
     7890(with-upgradability ()
     7891  (define-condition operation-definition-warning (simple-warning)
     7892    ()
     7893    (:documentation "Warning condition related to definition of obsolete OPERATION objects."))
     7894
     7895  (define-condition operation-definition-error (simple-error)
     7896    ()
     7897    (:documentation "Error condition related to definition of incorrect OPERATION objects."))
     7898
     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)))))
     7908
     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)))))
     7917
     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)))))
     7927
     7928  (defmethod downward-operation ((o operation)) nil)
     7929  (defmethod sideway-operation ((o operation)) nil))
     7930
     7931
     7932;;;---------------------------------------------------------------------------
     7933;;; End of OPERATION class checking
     7934;;;---------------------------------------------------------------------------
    78697935
    78707936
     
    78807946
    78817947  (defmethod operation-done-p ((o operation) (c component))
    7882     (declare (ignorable o c))
    78837948    t)
    78847949
     
    79027967       t)))
    79037968  (defmethod output-files ((o operation) (c component))
    7904     (declare (ignorable o c))
    79057969    nil)
    79067970  (defun output-file (operation component)
     
    79167980
    79177981  (defmethod input-files ((o operation) (c component))
    7918     (declare (ignorable o c))
    79197982    nil)
    79207983
     
    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
    80208088
    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)))
    80668134
    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))))
    80928154
     
    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))
    82148265
     
    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))
    82328277
    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))
    82558294
     
    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))
    82668303
     
    82688305;;;; Plan
    82698306
    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))))
    83368373
    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
    83408376
    83418377  ;; TODO: eliminate NODE-FOR, use CONS.
     
    83488384
    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)))
    83538388
    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)))
     
    83748408
    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))))
    83998433
    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)
    84038436
    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))
    84078439
     
    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))
    84218450
    84228451
     
    84568485    (reduce-direct-dependencies operation component #'acons nil))
    84578486
     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.
     8492
    84588493  (defun visit-dependencies (plan operation component dependency-stamper &aux stamp)
    84598494    (map-direct-dependencies
     
    84658500
    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))
    85688611
     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.
     8625
    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
    86058669
    86068670
     
    86168680    (reverse (plan-actions-r plan)))
    86178681
    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))
    86228684
     
    86698731
    86708732;;;; Incidental traversals
     8733
     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
    87178782
    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
    8741 
    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
     8806
     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.
    87458810
    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)))
     
    88758939
    88768940  (defmethod perform ((o compile-op) (c require-system))
    8877     (declare (ignorable o c))
    88788941    nil)
    88798942
    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*)))
     
    88868948
    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
    89358996
    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 https://bugs.launchpad.net/asdf/+bug/485918
    92489308
    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
    95629621
    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
    96529711
    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
    98939952
    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) ())
    994310002
    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"))
    994810007
    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"))
    995610015
    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
    995810022
    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."))
    996610031
    996710032  (defclass monolithic-binary-op (monolithic-op binary-op)
     
    996910034    (:documentation "produce fasl and asd files for combined system and dependencies."))
    997010035
    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."))
    997310038
    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."))
    997810043
    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."))
    998210047
    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"))
    998810056
     
    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)
     
    1006610134
    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)
     
    1011110178
    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)))
    10184 
    10185   (defmethod perform ((o load-fasl-op) c)
    10186     (declare (ignorable o c))
    10187     nil)
    1018810249
    1018910250  (defmethod perform ((o load-fasl-op) (c system))
     
    1020410265    (every #'(lambda (c) (typep c 'compiled-file)) (component-children s)))
    1020510266
    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))
    1022110277
     
    1022510281(with-upgradability ()
    1022610282  (defmethod trivial-system-p ((s prebuilt-system))
    10227     (declare (ignorable s))
    1022810283    t)
    1022910284
    1023010285  (defmethod perform ((o lib-op) (c prebuilt-system))
    10231     (declare (ignorable o c))
    1023210286    nil)
    1023310287
    1023410288  (defmethod component-depends-on ((o lib-op) (c prebuilt-system))
    10235     (declare (ignorable o c))
    1023610289    nil)
    1023710290
    1023810291  (defmethod component-depends-on ((o monolithic-lib-op) (c prebuilt-system))
    10239     (declare (ignorable o))
    1024010292    nil))
    1024110293
     
    1031010362
    1031110363  (defmethod input-files ((o load-op) (s precompiled-system))
    10312     (declare (ignorable o))
    1031310364    (bundle-output-files (find-operation o 'fasl-op) s))
    1031410365
     
    1031710368
    1031810369  (defmethod component-depends-on ((o load-fasl-op) (s precompiled-system))
    10319     (declare (ignorable o))
    1032010370    `((load-op ,s) ,@(call-next-method))))
    1032110371
     
    1038110431    (declare (ignore force verbose version))
    1038210432    (apply #'operate 'binary-op system args)))
     10433
     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
    1038510445
    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) ())
    1041210472
    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)))
    1042010480
    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
    1047410534
    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))
    1052410584
    1052510585  (defun system-definition-pathname (x)
     
    1059110651
    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.
    1077310833
    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
    1089310955
    1089410956   #:try-recompiling
     
    1093710999;;;; ASDF-USER, where the action happens.
    1093811000
    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
    1094411008
    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.