Commit d78df051 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau Committed by Robert P. Goldman

2.28.1: various upgrade issues

1- To make life easier on Xach, stop requiring asdf.lisp to be loaded as source
before it's compiled. Instead, wrap each and every single form in an eval-when,
most of the time via the with-upgradability macro that also transforms
defun into defun* and defgeneric into defgeneric*.
Causes massive reindentation :-(

2- Have a proper :version for fallback systems.
Will make systems that check the version happier.

3- protect a condition with #+sb-eval. Fixes lp#1116408.

4- Protect warnings-file methods with dynamic when *warnings-file-type*
rather than static #+.
parent 6f3a8730
* implement deferred warnings support on abcl, allegro, clisp, cmucl, lispworks, scl)
* fix upgrade on clisp
** Extract minimal test case
* Bug found by fe[nl]ix: infinite loop if the definitions in an asd file
......
......@@ -19,21 +19,24 @@
#:action-path #:find-action #:stamp #:done-p))
(in-package :asdf/action)
(deftype action () '(cons operation component)) ;; a step to be performed while building the system
(with-upgradability ()
(deftype action () '(cons operation component)) ;; a step to be performed while building the system
(defgeneric* traverse-actions (actions &key &allow-other-keys))
(defgeneric* traverse-sub-actions (operation component &key &allow-other-keys))
(defgeneric* required-components (component &key &allow-other-keys))
(defgeneric traverse-actions (actions &key &allow-other-keys))
(defgeneric traverse-sub-actions (operation component &key &allow-other-keys))
(defgeneric required-components (component &key &allow-other-keys)))
;;;; Reified representation for storage or debugging. Note: dropping original-initags
(defun action-path (action)
;;;; Reified representation for storage or debugging. Note: dropping original-initargs
(with-upgradability ()
(defun action-path (action)
(destructuring-bind (o . c) action (cons (type-of o) (component-find-path c))))
(defun find-action (path)
(destructuring-bind (o . c) path (cons (make-operation o) (find-component () c))))
(defun find-action (path)
(destructuring-bind (o . c) path (cons (make-operation o) (find-component () c)))))
;;;; Convenience methods
(defmacro define-convenience-action-methods
(with-upgradability ()
(defmacro define-convenience-action-methods
(function (operation component &optional keyp)
&key if-no-operation if-no-component operation-initargs)
(let* ((rest (gensym "REST"))
......@@ -59,32 +62,32 @@
(let ((,found (find-component () ,component)))
(if ,found
,(next-method operation found)
,if-no-component))))))))
,if-no-component)))))))))
;;;; self-description
(defgeneric* action-description (operation component)
(with-upgradability ()
(defgeneric action-description (operation component)
(:documentation "returns a phrase that describes performing this operation
on this component, e.g. \"loading /a/b/c\".
You can put together sentences using this phrase."))
(defmethod action-description (operation component)
(defmethod action-description (operation component)
(format nil (compatfmt "~@<~A on ~A~@:>")
(type-of operation) component))
(defgeneric* (explain) (operation component))
(defmethod explain ((o operation) (c component))
(defgeneric* (explain) (operation component))
(defmethod explain ((o operation) (c component))
(asdf-message (compatfmt "~&~@<; ~@;~A~:>~%") (action-description o c)))
(define-convenience-action-methods explain (operation component))
(define-convenience-action-methods explain (operation component))
(defun* format-action (stream action &optional colon-p at-sign-p)
(defun format-action (stream action &optional colon-p at-sign-p)
(assert (null colon-p)) (assert (null at-sign-p))
(destructuring-bind (operation . component) action
(princ (action-description operation component) stream)))
(princ (action-description operation component) stream))))
;;;; Dependencies
(defgeneric* component-depends-on (operation component) ;; ASDF4: rename to component-dependencies
(with-upgradability ()
(defgeneric component-depends-on (operation component) ;; ASDF4: rename to component-dependencies
(:documentation
"Returns a list of dependencies needed by the component to perform
the operation. A dependency has one of the following forms:
......@@ -100,68 +103,70 @@ You can put together sentences using this phrase."))
Methods specialized on subclasses of existing component types
should usually append the results of CALL-NEXT-METHOD to the
list."))
(defgeneric* component-self-dependencies (operation component))
(define-convenience-action-methods component-depends-on (operation component))
(define-convenience-action-methods component-self-dependencies (operation component))
(defgeneric component-self-dependencies (operation component))
(define-convenience-action-methods component-depends-on (operation component))
(define-convenience-action-methods component-self-dependencies (operation component))
(defmethod component-depends-on ((o operation) (c component))
(defmethod component-depends-on ((o operation) (c component))
(cdr (assoc (type-of o) (component-in-order-to c)))) ; User-specified in-order dependencies
(defmethod component-self-dependencies ((o operation) (c component))
(defmethod component-self-dependencies ((o operation) (c component))
;; NB: result in the same format as component-depends-on
(loop* :for (o-spec . c-spec) :in (component-depends-on o c)
:unless (eq o-spec 'feature) ;; avoid the FEATURE "feature"
:when (find c c-spec :key #'(lambda (dep) (resolve-dependency-spec c dep)))
:collect (list o-spec c)))
:collect (list o-spec c))))
;;;; upward-operation, downward-operation
;; These together handle actions that propagate along the component hierarchy.
;; Downward operations like load-op or compile-op propagate down the hierarchy:
;; operation on a parent depends-on operation on its children.
;; By default, an operation propagates itself, but it may propagate another one instead.
(defclass downward-operation (operation)
(with-upgradability ()
(defclass downward-operation (operation)
((downward-operation
:initform nil :initarg :downward-operation :reader downward-operation)))
(defmethod component-depends-on ((o downward-operation) (c parent-component))
(defmethod component-depends-on ((o downward-operation) (c parent-component))
`((,(or (downward-operation o) o) ,@(component-children c)) ,@(call-next-method)))
;; Upward operations like prepare-op propagate up the component hierarchy:
;; operation on a child depends-on operation on its parent.
;; By default, an operation propagates itself, but it may propagate another one instead.
(defclass upward-operation (operation)
;; Upward operations like prepare-op propagate up the component hierarchy:
;; operation on a child depends-on operation on its parent.
;; By default, an operation propagates itself, but it may propagate another one instead.
(defclass upward-operation (operation)
((upward-operation
:initform nil :initarg :downward-operation :reader upward-operation)))
;; For backward-compatibility reasons, a system inherits from module and is a child-component
;; so we must guard against this case. ASDF4: remove that.
(defmethod component-depends-on ((o upward-operation) (c child-component))
;; For backward-compatibility reasons, a system inherits from module and is a child-component
;; so we must guard against this case. ASDF4: remove that.
(defmethod component-depends-on ((o upward-operation) (c child-component))
`(,@(if-let (p (component-parent c))
`((,(or (upward-operation o) o) ,p))) ,@(call-next-method)))
;; Sibling operations propagate to siblings in the component hierarchy:
;; operation on a child depends-on operation on its parent.
;; By default, an operation propagates itself, but it may propagate another one instead.
(defclass sibling-operation (operation)
;; Sibling operations propagate to siblings in the component hierarchy:
;; operation on a child depends-on operation on its parent.
;; By default, an operation propagates itself, but it may propagate another one instead.
(defclass sibling-operation (operation)
((sibling-operation
:initform nil :initarg :sibling-operation :reader sibling-operation)))
(defmethod component-depends-on ((o sibling-operation) (c component))
(defmethod component-depends-on ((o sibling-operation) (c component))
`((,(or (sibling-operation o) o)
,@(loop :for dep :in (component-sibling-dependencies c)
:collect (resolve-dependency-spec c dep)))
,@(call-next-method)))
,@(call-next-method))))
;;;; Inputs, Outputs, and invisible dependencies
(defgeneric* (output-files) (operation component))
(defgeneric* (input-files) (operation component))
(defgeneric* (operation-done-p) (operation component)
(with-upgradability ()
(defgeneric* (output-files) (operation component))
(defgeneric* (input-files) (operation component))
(defgeneric* (operation-done-p) (operation component)
(:documentation "Returns a boolean, which is NIL if the action is forced to be performed again"))
(define-convenience-action-methods output-files (operation component))
(define-convenience-action-methods input-files (operation component))
(define-convenience-action-methods operation-done-p (operation component))
(define-convenience-action-methods output-files (operation component))
(define-convenience-action-methods input-files (operation component))
(define-convenience-action-methods operation-done-p (operation component))
(defmethod operation-done-p ((o operation) (c component))
(defmethod operation-done-p ((o operation) (c component))
(declare (ignorable o c))
t)
(defmethod output-files :around (operation component)
(defmethod output-files :around (operation component)
"Translate output files, unless asked not to. Memoize the result."
operation component ;; hush genera, not convinced by declare ignorable(!)
(do-asdf-cache `(output-files ,operation ,component)
......@@ -179,40 +184,40 @@ You can put together sentences using this phrase."))
absolute-pathnames
(mapcar *output-translation-function* absolute-pathnames))))
t)))
(defmethod output-files ((o operation) (c component))
(defmethod output-files ((o operation) (c component))
(declare (ignorable o c))
nil)
(defun* output-file (operation component)
(defun output-file (operation component)
"The unique output file of performing OPERATION on COMPONENT"
(let ((files (output-files operation component)))
(assert (length=n-p files 1))
(first files)))
(defmethod input-files :around (operation component)
(defmethod input-files :around (operation component)
"memoize input files."
(do-asdf-cache `(input-files ,operation ,component)
(call-next-method)))
(defmethod input-files ((o operation) (c parent-component))
(defmethod input-files ((o operation) (c parent-component))
(declare (ignorable o c))
nil)
(defmethod input-files ((o operation) (c component))
(defmethod input-files ((o operation) (c component))
(or (loop* :for (dep-o) :in (component-self-dependencies o c)
:append (or (output-files dep-o c) (input-files dep-o c)))
;; no non-trivial previous operations needed?
;; I guess we work with the original source file, then
(if-let ((pathname (component-pathname c)))
(and (file-pathname-p pathname) (list pathname)))))
(and (file-pathname-p pathname) (list pathname))))))
;;;; Done performing
(with-upgradability ()
(defgeneric component-operation-time (operation component)) ;; ASDF4: hide it behind plan-action-stamp
(define-convenience-action-methods component-operation-time (operation component))
(defgeneric* component-operation-time (operation component)) ;; ASDF4: hide it behind plan-action-stamp
(define-convenience-action-methods component-operation-time (operation component))
(defgeneric* mark-operation-done (operation component)) ;; ASDF4: hide it behind (setf plan-action-stamp)
(defgeneric* compute-action-stamp (plan operation component &key just-done)
(defgeneric mark-operation-done (operation component)) ;; ASDF4: hide it behind (setf plan-action-stamp)
(defgeneric compute-action-stamp (plan operation component &key just-done)
(:documentation "Has this action been successfully done already,
and at what known timestamp has it been done at or will it be done at?
Takes two keywords JUST-DONE and PLAN:
......@@ -227,7 +232,7 @@ Returns two values:
* a boolean DONE-P that indicates whether the action has actually been done,
and both its output-files and its in-image side-effects are up to date."))
(defclass action-status ()
(defclass action-status ()
((stamp
:initarg :stamp :reader action-stamp
:documentation "STAMP associated with the ACTION if it has been completed already
......@@ -237,43 +242,43 @@ in some previous image, or T if it needs to be done.")
:documentation "a boolean, true iff the action was already done (before any planned action)."))
(:documentation "Status of an action"))
(defmethod print-object ((status action-status) stream)
(defmethod print-object ((status action-status) stream)
(print-unreadable-object (status stream :type t)
(with-slots (stamp done-p) status
(format stream "~@{~S~^ ~}" :stamp stamp :done-p done-p))))
(defmethod component-operation-time ((o operation) (c component))
(defmethod component-operation-time ((o operation) (c component))
(gethash (type-of o) (component-operation-times c)))
(defmethod mark-operation-done ((o operation) (c component))
(defmethod mark-operation-done ((o operation) (c component))
(setf (gethash (type-of o) (component-operation-times c))
(compute-action-stamp nil o c :just-done t)))
(compute-action-stamp nil o c :just-done t))))
;;;; Perform
(with-upgradability ()
(defgeneric* (perform-with-restarts) (operation component))
(defgeneric* (perform) (operation component))
(define-convenience-action-methods perform (operation component))
(defgeneric* (perform-with-restarts) (operation component))
(defgeneric* (perform) (operation component))
(define-convenience-action-methods perform (operation component))
(defmethod perform :before ((o operation) (c component))
(defmethod perform :before ((o operation) (c component))
(ensure-all-directories-exist (output-files o c)))
(defmethod perform :after ((o operation) (c component))
(defmethod perform :after ((o operation) (c component))
(mark-operation-done o c))
(defmethod perform ((o operation) (c parent-component))
(defmethod perform ((o operation) (c parent-component))
(declare (ignorable o c))
nil)
(defmethod perform ((o operation) (c source-file))
(defmethod perform ((o operation) (c source-file))
(sysdef-error
(compatfmt "~@<Required method PERFORM not implemented for operation ~A, component ~A~@:>")
(class-of o) (class-of c)))
(defmethod perform-with-restarts (operation component)
(defmethod perform-with-restarts (operation component)
;; TOO verbose, especially as the default. Add your own :before method
;; to perform-with-restart or perform if you want that:
#|(explain operation component)|#
(perform operation component))
(defmethod perform-with-restarts :around (operation component)
(defmethod perform-with-restarts :around (operation component)
(loop
(restart-case
(return (call-next-method))
......@@ -288,9 +293,10 @@ in some previous image, or T if it needs to be done.")
(format s (compatfmt "~@<Continue, treating ~A as having been successful.~@:>")
(action-description operation component)))
(mark-operation-done operation component)
(return)))))
(return))))))
;;; Generic build operation
(defmethod component-depends-on ((o build-op) (c component))
`((,(or (component-build-operation c) 'load-op) ,c)))
(with-upgradability ()
(defmethod component-depends-on ((o build-op) (c component))
`((,(or (component-build-operation c) 'load-op) ,c))))
......@@ -29,9 +29,9 @@
:description "The defsystem part of ASDF"
:long-name "Another System Definition Facility"
:description "The portable defsystem for Common Lisp"
:long-description "ASDF/DEFSYSTEM is the standard DEFSYSTEM facility for Common Lisp,
:long-description "ASDF/DEFSYSTEM is the de facto standard DEFSYSTEM facility for Common Lisp,
a successor to Dan Barlow's ASDF and Francois-Rene Rideau's ASDF2.
For bootstrap purposes, it comes bundled with ASDF/DRIVER in a single file asdf.lisp."
For bootstrap purposes, it comes bundled with ASDF/DRIVER in a single file, asdf.lisp."
:homepage "http://common-lisp.net/projects/asdf/"
:bug-tracker "https://launchpad.net/asdf/"
:mailto "asdf-devel@common-lisp.net"
......@@ -74,25 +74,13 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.28" ;; to be automatically updated by make bump-version
:version "2.28.1" ;; to be automatically updated by make bump-version
:depends-on ()
#+asdf3 :encoding #+asdf3 :utf-8
;; For most purposes, asdf itself specially counts as a builtin system.
;; If you want to link it or do something forbidden to builtin systems,
;; specify separate dependencies on asdf-driver and asdf-defsystem.
#+asdf3 :builtin-system-p #+asdf3 t
:components
((:module "build"
:components
(#-gcl2.6
(:file "asdf"
#+asdf3 :in-order-to #+asdf3 ((compile-op (load-source-op "asdf")))))))
:in-order-to (#+asdf3 (prepare-source-op (monolithic-concatenate-source-op :asdf/defsystem))))
:components ((:module "build" :components ((:file "asdf"))))
:in-order-to (#+asdf3 (prepare-op (monolithic-concatenate-source-op :asdf/defsystem))))
;; Using :do-first instead of :in-order-to works above from ASDF 2.017 to 2.26,
;; but only this (or an equivalent defmethod component-do-first) works for ASDF1
#-asdf3
(setf (slot-value
(find-component (find-component (find-system "asdf") "build") "asdf")
'asdf::do-first)
'((compile-op (load-source-op "asdf"))))
......@@ -15,14 +15,15 @@
;;;; Backward compatibility with various pathname functions.
(defun* coerce-pathname (name &key type defaults)
(with-upgradability ()
(defun coerce-pathname (name &key type defaults)
;; For backward-compatibility only, for people using internals
;; Reported users in quicklisp: hu.dwim.asdf, asdf-utils, xcvb
;; Will be removed after 2014-01-16.
;;(warn "Please don't use ASDF::COERCE-PATHNAME. Use ASDF/PATHNAME:PARSE-UNIX-NAMESTRING.")
(parse-unix-namestring name :type type :defaults defaults))
(defun* component-name-to-pathname-components (unix-style-namestring
(defun component-name-to-pathname-components (unix-style-namestring
&key force-directory force-relative)
;; Will be removed after 2014-01-16.
;; (warn "Please don't use ASDF::COMPONENT-NAME-TO-PATHNAME-COMPONENTS, use SPLIT-UNIX-NAMESTRING-DIRECTORY-COMPONENTS")
......@@ -35,5 +36,5 @@
unix-style-namestring))
(values relabs path filename)))
#+(or ecl mkcl)
(defun* compile-file-keeping-object (&rest args) (apply #'compile-file* args))
#+(or ecl mkcl)
(defun compile-file-keeping-object (&rest args) (apply #'compile-file* args)))
......@@ -20,38 +20,39 @@
#:system-definition-pathname))
(in-package :asdf/backward-interface)
(define-condition operation-error (error) ;; Bad, backward-compatible name
(with-upgradability ()
(define-condition operation-error (error) ;; Bad, backward-compatible name
;; Used by SBCL, cffi-tests, clsql-mysql, clsql-uffi, qt, elephant, uffi-tests, sb-grovel
((component :reader error-component :initarg :component)
(operation :reader error-operation :initarg :operation))
(:report (lambda (c s)
(format s (compatfmt "~@<~A while invoking ~A on ~A~@:>")
(type-of c) (error-operation c) (error-component c)))))
(define-condition compile-error (operation-error) ())
(define-condition compile-failed (compile-error) ())
(define-condition compile-warned (compile-error) ())
(define-condition compile-error (operation-error) ())
(define-condition compile-failed (compile-error) ())
(define-condition compile-warned (compile-error) ())
(defun* component-load-dependencies (component)
(defun component-load-dependencies (component)
;; Old deprecated name for the same thing. Please update your software.
(component-sibling-dependencies component))
(defgeneric* operation-forced (operation)) ;; Used by swank.asd for swank-loader.
(defmethod operation-forced ((o operation)) (getf (operation-original-initargs o) :force))
(defgeneric operation-forced (operation)) ;; Used by swank.asd for swank-loader.
(defmethod operation-forced ((o operation)) (getf (operation-original-initargs o) :force))
(defgeneric* operation-on-warnings (operation))
(defgeneric* operation-on-failure (operation))
#-gcl2.6 (defgeneric* (setf operation-on-warnings) (x operation))
#-gcl2.6 (defgeneric* (setf operation-on-failure) (x operation))
(defmethod operation-on-warnings ((o operation))
(defgeneric operation-on-warnings (operation))
(defgeneric operation-on-failure (operation))
#-gcl2.6 (defgeneric (setf operation-on-warnings) (x operation))
#-gcl2.6 (defgeneric (setf operation-on-failure) (x operation))
(defmethod operation-on-warnings ((o operation))
(declare (ignorable o)) *compile-file-warnings-behaviour*)
(defmethod operation-on-failure ((o operation))
(defmethod operation-on-failure ((o operation))
(declare (ignorable o)) *compile-file-failure-behaviour*)
(defmethod (setf operation-on-warnings) (x (o operation))
(defmethod (setf operation-on-warnings) (x (o operation))
(declare (ignorable o)) (setf *compile-file-warnings-behaviour* x))
(defmethod (setf operation-on-failure) (x (o operation))
(defmethod (setf operation-on-failure) (x (o operation))
(declare (ignorable o)) (setf *compile-file-failure-behaviour* x))
(defun* system-definition-pathname (x)
(defun system-definition-pathname (x)
;; As of 2.014.8, we mean to make this function obsolete,
;; but that won't happen until all clients have been updated.
;;(cerror "Use ASDF:SYSTEM-SOURCE-FILE instead"
......@@ -62,12 +63,13 @@ We recommend you use ASDF:SYSTEM-SOURCE-FILE instead
for a mostly compatible replacement that we're supporting,
or even ASDF:SYSTEM-SOURCE-DIRECTORY or ASDF:SYSTEM-RELATIVE-PATHNAME
if that's whay you mean." ;;)
(system-source-file x))
(system-source-file x)))
;;;; ASDF-Binary-Locations compatibility
(defun* enable-asdf-binary-locations-compatibility
;; This remains supported for legacy user, but not recommended for new users.
(with-upgradability ()
(defun enable-asdf-binary-locations-compatibility
(&key
(centralize-lisp-binaries nil)
(default-toplevel-directory
......@@ -105,7 +107,7 @@ if that's whay you mean." ;;)
(t t)
:ignore-inherited-configuration))))
(defmethod operate :before (operation-class system &rest args &key &allow-other-keys)
(defmethod operate :before (operation-class system &rest args &key &allow-other-keys)
(declare (ignorable operation-class system args))
(when (find-symbol* '#:output-files-for-system-and-operation :asdf nil)
(error "ASDF 2 is not compatible with ASDF-BINARY-LOCATIONS, which you are using.
......@@ -115,15 +117,14 @@ and instead use ASDF-OUTPUT-TRANSLATIONS. See the ASDF manual for details.
In case you insist on preserving your previous A-B-L configuration, but
do not know how to achieve the same effect with A-O-T, you may use function
ASDF:ENABLE-ASDF-BINARY-LOCATIONS-COMPATIBILITY as documented in the manual;
call that function where you would otherwise have loaded and configured A-B-L.")))
call that function where you would otherwise have loaded and configured A-B-L."))))
;;;; run-shell-command
;;
;; WARNING! The function below is dysfunctional and deprecated.
;;; run-shell-command
;; WARNING! The function below is not just deprecated but also dysfunctional.
;; Please use asdf/run-program:run-program instead.
;;
(defun* run-shell-command (control-string &rest args)
(with-upgradability ()
(defun run-shell-command (control-string &rest args)
"Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
synchronously execute the result using a Bourne-compatible shell, with
output to *VERBOSE-OUT*. Returns the shell's exit code.
......@@ -133,21 +134,23 @@ Deprecated function, for backward-compatibility only.
Please use ASDF-DRIVER:RUN-PROGRAM instead."
(let ((command (apply 'format nil control-string args)))
(asdf-message "; $ ~A~%" command)
(run-program command :force-shell t :ignore-error-status t :output *verbose-out*)))
(run-program command :force-shell t :ignore-error-status t :output *verbose-out*))))
(defvar *asdf-verbose* nil) ;; backward-compatibility with ASDF2 only. Unused.
(with-upgradability ()
(defvar *asdf-verbose* nil)) ;; backward-compatibility with ASDF2 only. Unused.
;; backward-compatibility methods. Do NOT use in new code. NOT SUPPORTED.
(defgeneric* component-property (component property))
#-gcl2.6 (defgeneric* (setf component-property) (new-value component property))
(with-upgradability ()
(defgeneric component-property (component property))
(defgeneric (setf component-property) (new-value component property))
(defmethod component-property ((c component) property)
(defmethod component-property ((c component) property)
(cdr (assoc property (slot-value c 'properties) :test #'equal)))
(defmethod (setf component-property) (new-value (c component) property)
(defmethod (setf component-property) (new-value (c component) property)
(let ((a (assoc property (slot-value c 'properties) :test #'equal)))
(if a
(setf (cdr a) new-value)
(setf (slot-value c 'properties)
(acons property new-value (slot-value c 'properties)))))
new-value)
new-value))
......@@ -15,11 +15,11 @@
(in-package :asdf/backward-internals)
;;;; Backward compatibility with "inline methods"
(defparameter +asdf-methods+
(with-upgradability ()
(defparameter +asdf-methods+
'(perform-with-restarts perform explain output-files operation-done-p))
(defun* %remove-component-inline-methods (component)
(defun %remove-component-inline-methods (component)
(dolist (name +asdf-methods+)
(map ()
;; this is inefficient as most of the stored
......@@ -31,7 +31,7 @@
;; clear methods, then add the new ones
(component-inline-methods component) nil)
(defun* %define-component-inline-methods (ret rest)
(defun %define-component-inline-methods (ret rest)
(dolist (name +asdf-methods+)
(let ((keyword (intern (symbol-name name) :keyword)))
(loop :for data = rest :then (cddr data)
......@@ -45,16 +45,17 @@
,@body))
(component-inline-methods ret)))))))
(defun* %refresh-component-inline-methods (component rest)
(defun %refresh-component-inline-methods (component rest)
(%remove-component-inline-methods component)
(%define-component-inline-methods component rest))
(%define-component-inline-methods component rest)))
;;;; PARTIAL SUPPORT for the :if-component-dep-fails component attribute
;; and the companion asdf:feature pseudo-dependency.
;; This won't recurse into dependencies to accumulate feature conditions.
;; Therefore it will accept the SB-ROTATE-BYTE of an old SBCL
;; (older than 1.1.2.20-fe6da9f) but won't suffice to load an old nibbles.
(defun* %resolve-if-component-dep-fails (if-component-dep-fails component)
(with-upgradability ()
(defun %resolve-if-component-dep-fails (if-component-dep-fails component)
(asdf-message "The system definition for ~S uses deprecated ~
ASDF option :IF-COMPONENT-DEP-DAILS. ~
Starting with ASDF 3, please use :IF-FEATURE instead"
......@@ -67,22 +68,23 @@
:for c :in (component-children component) :do
(loop* :for (feature? feature) :in (component-depends-on o c)
:when (eq feature? 'feature) :do
(setf (component-if-feature c) feature)))))
(setf (component-if-feature c) feature))))))
(when-upgrading (:when (fboundp 'make-sub-operation))
(defun* make-sub-operation (c o dep-c dep-o)
(defun make-sub-operation (c o dep-c dep-o)
(declare (ignore c o dep-c dep-o)) (asdf-upgrade-error)))
;;;; load-sysdef
(defun* load-sysdef (name pathname)
(with-upgradability ()
(defun load-sysdef (name pathname)
(load-asd pathname :name name))
(defun* make-temporary-package ()
(defun make-temporary-package ()
;; For loading a .asd file, we dont't make a temporary package anymore,
;; but use ASDF-USER. I'd like to have this function do this,
;; but since whoever uses it is likely to delete-package the result afterwards,
;; this would be a bad idea, so preserve the old behavior.
(make-package (fresh-package-name :prefix :asdf :index 0) :use '(:cl :asdf)))
(make-package (fresh-package-name :prefix :asdf :index 0) :use '(:cl :asdf))))
......@@ -20,7 +20,8 @@
#:build-args #:name-suffix #:prologue-code #:epilogue-code #:static-library))
(in-package :asdf/bundle)
(defclass bundle-op (operation)
(with-upgradability ()
(defclass bundle-op (operation)
((build-args :initarg :args :initform nil :accessor bundle-op-build-args)
(name-suffix :initarg :name-suffix :initform nil)
(bundle-type :initform :no-output-file :reader bundle-type)
......@@ -28,55 +29,55 @@
#+mkcl (do-fasb :initarg :do-fasb :initform t :reader bundle-op-do-fasb-p)
#+mkcl (do-static-library :initarg :do-static-library :initform t :reader bundle-op-do-static-library-p)))
(defclass fasl-op (bundle-op)
(defclass fasl-op (bundle-op)
;; create a single fasl for the entire library
((bundle-type :initform :fasl)))
(defclass load-fasl-op (basic-load-op)
(defclass load-fasl-op (basic-load-op)
;; load a single fasl for the entire library
())
(defclass lib-op (bundle-op)
(defclass lib-op (bundle-op)
;; On ECL: compile the system and produce linkable .a library for it.
;; On others: just compile the system.
((bundle-type :initform #+(or ecl mkcl) :lib #-(or ecl mkcl) :no-output-file)))
(defclass dll-op (bundle-op)
(defclass dll-op (bundle-op)