Commit 8dc0778f authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Merge branch 'master' into syntax-control

Getting ready for merge into master.
parents d3958f1d 2a5bc3be
......@@ -67,5 +67,7 @@ debian/files
/.DS_Store
core
# Hack: ignore the GNUmakefile here, so you can ln -s Makefile-lisp-scripting GNUmakefile
GNUmakefile
......@@ -10,13 +10,15 @@
** Maybe remove old versions from upgrade tests; or maybe not:
if we support old versions in any way,
it should be for upgrade only, and "punt" is acceptable.
** Maybe remove upgrade from antique ASDF altogether.
Clear all the code in the header, and/or
move a few elements to asdf/upgrade.
** Upgrade tests might be split in two test sets: short and long.
** Make tests stateless and/or make any modifications private,
so that they can be run in parallel.
* Have a better story for linking C static or dynamic libraries.
** Some groundwork has been done in cffi-toolchain, but an interface must be designed.
** Then you'll have to migrate all the code in Quicklisp to use your new interface.
** See commonqt's qt.asd and qtools's qt-libs.asd for instances of ugliness.
* Testing support
** Replace test-op with run-test-op and test-report-op ?
......@@ -122,6 +124,7 @@
rather than `#(1 2 3 2 3 2 3 2 3)` or even better `#(1 2 3 3 3)`.
*** It purports to support Unicode, but it has only 16-bit characters.
Note that (subtypep 'character 'base-char) says T -- everything is a base char(!)
*** In general, running upgrade tests triggers massive CLOS breakage on CMUCL.
** SCL has bugs:
*** it doesn't like run-program from a modified directory?
......@@ -222,12 +225,6 @@
* Learn to use cl-grid-test
** So we can easily make sure ASDF changes don't break stuff,
and that breakage gets fixed quickly.
** So we see if ASDF-USER can :use most (all?) of UIOP.
SB-GROVEL used (until 25c1769 from 2013-02-23) to :use both ASDF and
SB-EXT, which prevents ASDF from exporting RUN-PROGRAM, but
should not be a problem with ASDF-USER :use'ing UIOP.
A run of quicklisp is necessary, with an eye also for warnings
from .asd's that might be overriding definitions in UIOP(!)
* Diagnostics
** have a mode to explain WHY a component needs to be recompiled.
......@@ -244,39 +241,18 @@
* have a single test .asd that tests as many features as possible, use it for upgrade test.
* Bug found by fe[nl]ix: infinite loop if the definitions in an asd file
are not in strict defsystem-depends-on dependency order.
** At least document the issue.
** Real solution: defer parsing and evaluation of defsystem forms?
Or simply detect circularity and issue an appropriate error?
* Include some ABL test for stassats's (now obsolete?) thing:
(asdf:enable-asdf-binary-locations-compatibility
:centralize-lisp-binaries t :default-toplevel-directory *fasl-dir*)
** Or deprecate and remove ABL compatibility altogether? Move it to contrib?
No one has been using ASDF1 for years.
There is no ABL to be compatible with —
is anyone still using the compatibility mode?
Maybe issue a warning, then a cerror, before to remove the code?
* Make load-op a generic operation that selects the proper strategy?
for each system, module or file, according to component properties and user-configuration:
compile the lisp file then load the fasl (load-fasl-op on a cl-source-file),
load the lisp file without compiling (load-source-op),
compile all files for the system, link them and load the result
(load-fasl-op on the system),
compile all files for the system *and* its dependencies, link and load (monolithic-load-fasl-op),
concatenate all files for the system, then load the result (load-concatenated-source-op),
concatenate all files for the system, then link them and load the result (load-compiled-concatenated-op),
concatenate all files for the system *and* its dependencies, link and load (monolithic-load-compiled-concatenated-op).
* operation cleanup?
** Kill backward-compat functions after all clients have moved on.
** Kill original-initargs -- BEWARE, it currently has clients!
*** current ECL users used to depend on it for bundles, and may or may
not be satisfied with how it's not propagated anymore.
*** SLIME uses it (!)
*** weblocks uses it (!)
** Refactor operation classes in action.lisp to not use slots for metadata
*** See commit message for 8e68ac229c19b7b611caf942a7f0998c88047a79
*** The problem: slots will NOT get properly upgraded with new initform.
*** Bad solution: A U-I-F-R-C method might do but would be much more complex to maintain,
not just for ASDF but potentially for anyone who defines extensions to ASDF.
*** The solution: use defmethod self-operation, not a self-operation slot.
This solution is trivially backward-compatible with older variants of ASDF.
*** Migration: find everyone on Quicklisp that defines an operation, and have them use defmethod.
Document all that in asdf.texinfo. Yet, unless noone is affected in Quicklisp,
don't modify ASDF classes themselves until a year or two afterwards, for compatibility purposes;
and/or when ASDF classes themselves need to be modified for the sake of some fix.
** To allow semantically distinct operations of the same class:
You'd need to have a protocol to canonicalize them
in the *OPERATIONS* memoization table, not by class name,
......@@ -461,8 +437,15 @@ a reified context for featurep checks, etc.
by having all functions and macros under the old package name be
proxies to those in the new package name?
(Exception: special variables can't be proxies, have to be imported.)
** Eradicate Quicklisp systems that depend on asdf-driver or
asdf-package-system, make them depend on uiop and asdf3.1 instead.
** Delete asdf-driver.asd, nobody has used it in years
** Eradicate Quicklisp systems that depend on asdf-package-system, make them depend on asdf3.1 instead.
** Deprecate and remove asdf-binary-locations (ABL) compatibility altogether.
No one has been using ASDF1 for years.
There is no ABL to be compatible with —
is anyone still using the compatibility mode?
Maybe issue a warning, then a cerror, before to remove the code?
* Fix plan
** Goal: Implement proper incrementality for defsystem-depends-on.
......
......@@ -84,7 +84,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "3.3.1" ;; to be automatically updated by make bump-version
:version "3.3.1.3" ;; to be automatically updated by make bump-version
:depends-on ()
#+asdf3 :encoding #+asdf3 :utf-8
:class #+asdf3.1 package-inferred-system #-asdf3.1 system
......
......@@ -22,12 +22,9 @@
(in-package :asdf/bundle)
(with-upgradability ()
(defclass bundle-op (operation)
;; NB: use of instance-allocated slots for operations is DEPRECATED
;; and only supported in a temporary fashion for backward compatibility.
;; Supported replacement: Define slots on program-system instead.
((bundle-type :initform :no-output-file :reader bundle-type :allocation :class))
(defclass bundle-op (operation) ()
(:documentation "base class for operations that bundle outputs from multiple components"))
(defgeneric bundle-type (bundle-op))
(defclass monolithic-op (operation) ()
(:documentation "A MONOLITHIC operation operates on a system *and all of its
......@@ -68,10 +65,11 @@ itself."))
(defclass link-op (bundle-op) ()
(:documentation "Abstract operation for linking files together"))
(defclass gather-operation (bundle-op)
((gather-operation :initform nil :allocation :class :reader gather-operation)
(gather-type :initform :no-output-file :allocation :class :reader gather-type))
(defclass gather-operation (bundle-op) ()
(:documentation "Abstract operation for gathering many input files from a system"))
(defgeneric gather-operation (gather-operation))
(defmethod gather-operation ((o gather-operation)) nil)
(defgeneric gather-type (gather-operation))
(defun operation-monolithic-p (op)
(typep op 'monolithic-op))
......@@ -108,11 +106,12 @@ itself."))
`((,go ,@deps) ,@(call-next-method))))
;; Create a single fasl for the entire library
(defclass basic-compile-bundle-op (bundle-op basic-compile-op)
((gather-type :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :object
:allocation :class)
(bundle-type :initform :fasb :allocation :class))
(defclass basic-compile-bundle-op (bundle-op basic-compile-op) ()
(:documentation "Base class for compiling into a bundle"))
(defmethod bundle-type ((o basic-compile-bundle-op)) :fasb)
(defmethod gather-type ((o basic-compile-bundle-op))
#-(or clasp ecl mkcl) :fasl
#+(or clasp ecl mkcl) :object)
;; Analog to prepare-op, for load-bundle-op and compile-bundle-op
(defclass prepare-bundle-op (sideway-operation)
......@@ -121,9 +120,7 @@ itself."))
:allocation :class))
(:documentation "Operation class for loading the bundles of a system's dependencies"))
(defclass lib-op (link-op gather-operation non-propagating-operation)
((gather-type :initform :object :allocation :class)
(bundle-type :initform :lib :allocation :class))
(defclass lib-op (link-op gather-operation non-propagating-operation) ()
(:documentation "Compile the system and produce a linkable static library (.a/.lib)
for all the linkable object files associated with the system. Compare with DLL-OP.
......@@ -132,6 +129,8 @@ written in C or another language with a compiler producing linkable object files
On CLASP, ECL, MKCL, these object files _also_ include the contents of Lisp files
themselves. In any case, this operation will produce what you need to further build
a static runtime for your system, or a dynamic library to load in an existing runtime."))
(defmethod bundle-type ((o lib-op)) :lib)
(defmethod gather-type ((o lib-op)) :object)
;; What works: on ECL, CLASP(?), MKCL, we link the many .o files from the system into the .so;
;; on other implementations, we combine (usually concatenate) the .fasl files into one.
......@@ -155,11 +154,11 @@ faster and more resource efficient."))
;; we'd have to have the monolithic-op not inherit from the main op,
;; but instead inherit from a basic-FOO-op as with basic-compile-bundle-op above.
(defclass dll-op (link-op gather-operation non-propagating-operation)
((gather-type :initform :object :allocation :class)
(bundle-type :initform :dll :allocation :class))
(defclass dll-op (link-op gather-operation non-propagating-operation) ()
(:documentation "Compile the system and produce a dynamic loadable library (.so/.dll)
for all the linkable object files associated with the system. Compare with LIB-OP."))
(defmethod bundle-type ((o dll-op)) :dll)
(defmethod gather-type ((o dll-op)) :object)
(defclass deliver-asd-op (basic-compile-op selfward-operation)
((selfward-operation
......@@ -188,27 +187,25 @@ for all the linkable object files associated with the system. Compare with LIB-O
((selfward-operation :initform 'monolithic-compile-bundle-op :allocation :class))
(:documentation "Load a single fasl for the system and its dependencies."))
(defclass monolithic-lib-op (lib-op monolithic-bundle-op non-propagating-operation)
((gather-type :initform :object :allocation :class))
(defclass monolithic-lib-op (lib-op monolithic-bundle-op non-propagating-operation) ()
(:documentation "Compile the system and produce a linkable static library (.a/.lib)
for all the linkable object files associated with the system or its dependencies. See LIB-OP."))
(defclass monolithic-dll-op (dll-op monolithic-bundle-op non-propagating-operation)
((gather-type :initform :object :allocation :class))
(defclass monolithic-dll-op (dll-op monolithic-bundle-op non-propagating-operation) ()
(:documentation "Compile the system and produce a dynamic loadable library (.so/.dll)
for all the linkable object files associated with the system or its dependencies. See LIB-OP"))
(defclass image-op (monolithic-bundle-op selfward-operation
#+(or clasp ecl mkcl) link-op #+(or clasp ecl mkcl) gather-operation)
((bundle-type :initform :image :allocation :class)
(gather-operation :initform 'lib-op :allocation :class)
#+(or clasp ecl mkcl) (gather-type :initform :static-library :allocation :class)
(selfward-operation :initform '(#-(or clasp ecl mkcl) load-op) :allocation :class))
((selfward-operation :initform '(#-(or clasp ecl mkcl) load-op) :allocation :class))
(:documentation "create an image file from the system and its dependencies"))
(defmethod bundle-type ((o image-op)) :image)
#+(or clasp ecl mkcl) (defmethod gather-operation ((o image-op)) 'lib-op)
#+(or clasp ecl mkcl) (defmethod gather-type ((o image-op)) :static-library)
(defclass program-op (image-op)
((bundle-type :initform :program :allocation :class))
(defclass program-op (image-op) ()
(:documentation "create an executable file from the system and its dependencies"))
(defmethod bundle-type ((o program-op)) :program)
;; From the ASDF-internal bundle-type identifier, get a filesystem-usable pathname type.
(defun bundle-pathname-type (bundle-type)
......
......@@ -23,8 +23,8 @@
;;;
(with-upgradability ()
;; Base classes for both regular and monolithic concatenate-source operations
(defclass basic-concatenate-source-op (bundle-op)
((bundle-type :initform "lisp" :allocation :class)))
(defclass basic-concatenate-source-op (bundle-op) ())
(defmethod bundle-type ((o basic-concatenate-source-op)) "lisp")
(defclass basic-load-concatenated-source-op (basic-load-op selfward-operation) ())
(defclass basic-compile-concatenated-source-op (basic-compile-op selfward-operation) ())
(defclass basic-load-compiled-concatenated-source-op (basic-load-op selfward-operation) ())
......
......@@ -65,7 +65,7 @@ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
@titlepage
@title ASDF: Another System Definition Facility
@subtitle Manual for Version 3.3.1
@subtitle Manual for Version 3.3.1.3
@c The following two commands start the copyright page.
@page
@vskip 0pt plus 1filll
......@@ -82,7 +82,7 @@ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
@node Top, Introduction, (dir), (dir)
@top ASDF: Another System Definition Facility
@ifnottex
Manual for Version 3.3.1
Manual for Version 3.3.1.3
@end ifnottex
......@@ -6347,9 +6347,10 @@ Also, bugs are currently tracked on launchpad:
Available in updated-for-CL form on the web at
@url{http://nhplace.com/kent/Papers/Large-Systems.html}
@item Dan Weinreb and David Moon:
``Lisp Machine Manual'', MIT, 1981.
``Lisp Machine Manual'', 3rd Edition MIT, March 1981.
The famous CHINE NUAL describes one of the earliest variants of DEFSYSTEM.
@url{https://bitsavers.trailing-edge.com/pdf/mit/cadr/chinual_4thEd_Jul81.pdf}
(NB: Not present in the second preliminary version of January 1979)
@url{http://bitsavers.org/pdf/mit/cadr/chinual_3rdEd_Mar81.pdf}
@end itemize
......
......@@ -56,6 +56,8 @@ that are often wrong in systems seen in the wild.
* [Source File Types](#source_types)
* [Conditional Outputs and Conditional Perform](#conditional_outputs)
- [Other](#other)
+ [Syntax Control](#syntax_control)
+ [Using ASDF Internals](#using_asdf_internals)
<a name="trivial_examples"></a>Trivial Examples
......@@ -881,6 +883,8 @@ all those `perform`, `output-files` and `input-files` methods.
<a name="other"></a>Other
--------------------------
### <a name="syntax_control"></a>Syntax Control
Do not side-effect the current `*readtable*`,
which is never guaranteed to be writable, and
may not be what is current when you need the modification.
......@@ -890,3 +894,28 @@ To bind the readtable, use `named-readtables:in-readtable` or `cl-syntax:in-synt
in each file that needs a non-standard readtable, and/or use an `:around-compile` hook
to automatically bind it around every file in a module or system.
See the syntax-control document (in the syntax-control branch if it wasn't merged yet).
### <a name="using_asdf_internals"></a>Using ASDF Internals
At times, you will have to use some ASDF internals to get your software to work.
When this happens, follow these rules to minimize the breakage associated to bitrot:
* You MUST use the `asdf::` package prefix rather than `asdf/foo:`
to name the symbols internal to ASDF.
Indeed, from one version of ASDF to the next,
which internal package a symbol will reside in may change;
for instance `asdf/find-system:primary-system-name` recently became
`asdf/system:primary-system-name`
(it is still present, not exported, in the former system);
but it is always present (though not currently exported) in package `asdf`.
* When you use internals, you MUST notify the ASDF maintainers, and request
that they either export the symbol and support the API, or
offer an alternative API more to their liking for the same functionality.
Otherwise, they will be justified in modifying internals
that no one is supposed to use, and they will blame you when
they later change or remove these internals and your software breaks.
Note that the latter point is true of all software, not just ASDF.
......@@ -43,8 +43,9 @@
and the ability to deliver standalone executables.
Its notable versions include pre-release 2.27 on February 1st 2013,
first stable release 3.0.1 on May 16th 2013,
major releases 3.1.2 on May 6th 2014 and 3.2.0 on January 10th 2017,
and latest release 3.2.1 on April 3rd 2017.
major releases 3.1.2 on May 6th 2014,
3.2.0 on January 10th 2017 and 3.3.0 on October 6th 2017.
The latest release is 3.3.1, published on November 4th 2017.
</p>
<a id="what_it_is"></a>
<h3>What it is</h3>
......@@ -329,14 +330,17 @@
<a title="GNU Common Lisp" href="https://www.gnu.org/software/gcl/">GCL</a>,
<a title="Macintosh Common Lisp" href="https://en.wikipedia.org/wiki/Macintosh_Common_Lisp">MCL</a>
</td>
<td align="left">XCL</td></tr>
<td align="left"><a href="https://github.com/gnooth/xcl">XCL</a></td></tr>
<tr><th align="left">Proprietary</th>
<td align="left">
<a href="http://franz.com/products/allegro-common-lisp/">Allegro</a>,
<a href="http://www.lispworks.com/">LispWorks</a>
</td>
<td align="left"></td>
<td align="left">Genera, mocl, SCL</td></tr>
<td align="left">
<a href="https://en.wikipedia.org/wiki/Genera_(operating_system)">Genera</a>,
<a href="https://wukix.com/mocl">mocl</a>,
<a title="Scieneer Common Lisp" href="http://www.scieneer.com/scl/">SCL</a></td></tr>
</table>
<p>
To deal with an implementation that does not yet provide ASDF 3.1 or later,
......@@ -412,7 +416,7 @@ Corman Common Lisp <admin@cormanlisp.com>
About the latest developments in ASDF 3.2 and ASDF 3.3, see our demo
<cite><a href="http://fare.tunes.org/files/asdf2017/asdf2017.html"
>Delivering Common Lisp Applications with ASDF 3.3</a></cite>
(<a href="http://fare.tunes.org/files/asdf2017/asdf2017.pdf">PDF</a>,
(2-page <a href="http://fare.tunes.org/files/asdf2017/asdf2017.pdf">PDF</a>,
<a href="http://fare.tunes.org/files/asdf2017/els2017-slides.pdf">slides</a>,
<a href="https://github.com/fare/asdf2017">git</a>).
Regarding the internal design of ASDF in general,
......@@ -640,13 +644,12 @@ Corman Common Lisp <admin@cormanlisp.com>
<dl>
<dt>November 2017</dt>
<dd>Release of 3.3.1: bugfix release for 3.3.0 addressing
one backwards-incompatibility issue with timestamp
computations, and other minor tweaks.</dd>
<dl>
a backwards-incompatibility issue with timestamp computations,
and other minor breakage.</dd>
<dt>October 2017</dt>
<dd>Release of 3.3.0, with substantial revision to the build
plan, adding correct handling of
<code>DEFSYSTEM-DEPENDS-ON</code> dependencies.</dd>
<dd>Release of 3.3.0, with substantial revision to the build plan
to correct handle multiple phases of loading, due to e.g.
<code>DEFSYSTEM-DEPENDS-ON</code> dependencies.</dd>
<dt>April 2017</dt>
<dd>Release of 3.2.1, with many small bugfixes and cleanups.
Presentation at ELS 2017 about ASDF 3.3.
......@@ -760,9 +763,9 @@ Corman Common Lisp <admin@cormanlisp.com>
<a class="nav" href="http://www.catb.org/hacker-emblem/" title="hacker"> <img src="http://common-lisp.net/project/cl-containers/shared/buttons/hacker.png" width="80" height="15" title="hacker emblem" alt="hacker button" /></a>
<a class="nav" href="http://www.lisp.org/" title="Association of Lisp Users"> <img src="http://common-lisp.net/project/cl-containers/shared/buttons/lambda-lisp.png" width="80" height="15" title="ALU emblem" alt="ALU button" /></a>
<a class="nav" href="http://common-lisp.net/" title="Common-Lisp.net"> <img src="http://common-lisp.net/project/cl-containers/shared/buttons/lisp-lizard.png" width="80" height="15" title="Common-Lisp.net" alt="Common-Lisp.net button" /></a>
<p><span class="copyright"Copyright &copy; 2001-2016 Daniel Barlow and contributors</span></p>
<p><span class="copyright"Copyright &copy; 2001-2017 Daniel Barlow and contributors</span></p>
<p>ASDF has an <a href="http://www.opensource.org/licenses/mit-license.php">MIT style</a> license</p>
<div id="timestamp">Last updated 2017-04-30</div>
<div id="timestamp">Last updated 2017-12-01</div>
</div>
</body>
</html>
......@@ -10,4 +10,16 @@ We urge implementations that are currently bundling previous versions of ASDF --
Here is the changelog entry for 3.3.1:
FIXME: Changelog here.
\ No newline at end of file
cl-asdf (2:3.3.167-1) unstable; urgency=low
New milestone:
* UIOP compatibility fix: Introduced new replacement "timestamp"
comparison functions, because of inadvertent change in the
API. Functions that are compatible with the old semantics are retained
as "stamp" comparison functions, but will eventually be deprecated.
* Upgrade fix: Upgrade from 3.2.1 needed repair.
* Syntax manipulation: Fix for bugs that could be introduced when the
default readtable was manipulated during the loading of a
defsystem-depends-on system.
* Tests: tests for new capabilities and bugs
* Documentation: a number of improvements and clarifications.
......@@ -82,11 +82,9 @@
;; TODO: could this file be refactored so that locate-system is merely
;; the cache-priming call to input-files here?
(defmethod input-files ((o define-op) (s system))
(assert (equal (coerce-name s) (primary-system-name s)))
(if-let ((asd (system-source-file s))) (list asd)))
(defmethod perform ((o define-op) (s system))
(assert (equal (coerce-name s) (primary-system-name s)))
(nest
(if-let ((pathname (first (input-files o s)))))
(with-shared-syntax (:package :asdf-user))
......@@ -185,21 +183,25 @@ Do NOT try to load a .asd file directly with CL:LOAD. Always use ASDF:LOAD-ASD."
(defun locate-system (name)
"Given a system NAME designator, try to locate where to load the system from.
Returns five values: FOUNDP FOUND-SYSTEM PATHNAME PREVIOUS PREVIOUS-TIME
Returns six values: FOUNDP FOUND-SYSTEM PATHNAME PREVIOUS PREVIOUS-TIME PREVIOUS-PRIMARY
FOUNDP is true when a system was found,
either a new unregistered one or a previously registered one.
FOUND-SYSTEM when not null is a SYSTEM object that may be REGISTER-SYSTEM'ed.
PATHNAME when not null is a path from which to load the system,
either associated with FOUND-SYSTEM, or with the PREVIOUS system.
PREVIOUS when not null is a previously loaded SYSTEM object of same name.
PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded."
PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
PREVIOUS-PRIMARY when not null is the primary system for the PREVIOUS system."
(with-asdf-session () ;; NB: We don't cache the results. We once used to, but it wasn't useful,
;; and keeping a negative cache was a bug (see lp#1335323), which required
;; explicit invalidation in clear-system and find-system (when unsucccessful).
(let* ((name (coerce-name name))
(previous (registered-system name)) ; load from disk if absent or newer on disk
(primary (registered-system (primary-system-name name)))
(previous-time (and previous primary (component-operation-time 'define-op primary)))
(previous-primary-name (and previous (primary-system-name previous)))
(previous-primary-system (and previous-primary-name
(registered-system previous-primary-name)))
(previous-time (and previous-primary-system
(component-operation-time 'define-op previous-primary-system)))
(found (search-for-system-definition name))
(found-system (and (typep found 'system) found))
(pathname (ensure-pathname
......@@ -212,37 +214,38 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(unless (check-not-old-asdf-system name pathname)
(check-type previous system) ;; asdf is preloaded, so there should be a previous one.
(setf found-system nil pathname nil))
(values foundp found-system pathname previous previous-time))))
(values foundp found-system pathname previous previous-time previous-primary-system))))
;; TODO: make a prepare-define-op node for this
;; so we can properly cache the answer rather than recompute it.
(defun definition-dependencies-up-to-date-p (system)
(check-type system system)
(or (not (primary-system-p system))
(handler-case
(loop :with plan = (make-instance *plan-class*)
:for action :in (definition-dependency-list system)
:always (action-up-to-date-p
plan (action-operation action) (action-component action))
:finally
(let ((o (make-operation 'define-op)))
(multiple-value-bind (stamp done-p)
(compute-action-stamp plan o system)
(return (and (timestamp<= stamp (component-operation-time o system))
done-p)))))
(system-out-of-date () nil))))
;; Main method for find-system: first, make sure the computation is memoized in a session cache.
;; Unless the system is immutable, use locate-system to find the primary system;
;; reconcile the finding (if any) with any previous definition (in a previous session,
;; preloaded, with a previous configuration, or before filesystem changes), and
;; load a found .asd if appropriate. Finally, update registration table and return results.
(defun definition-dependencies-up-to-date-p (system)
(check-type system system)
(assert (primary-system-p system))
(handler-case
(loop :with plan = (make-instance *plan-class*)
:for action :in (definition-dependency-list system)
:always (action-up-to-date-p
plan (action-operation action) (action-component action))
:finally
(let ((o (make-operation 'define-op)))
(multiple-value-bind (stamp done-p)
(compute-action-stamp plan o system)
(return (and (timestamp<= stamp (component-operation-time o system))
done-p)))))
(system-out-of-date () nil)))
(defmethod find-system ((name string) &optional (error-p t))
(nest
(with-asdf-session (:key `(find-system ,name)))
(let ((name-primary-p (primary-system-p name)))
(unless name-primary-p (find-system (primary-system-name name) nil)))
(or (and *immutable-systems* (gethash name *immutable-systems*) (registered-system name)))
(multiple-value-bind (foundp found-system pathname previous previous-time)
(multiple-value-bind (foundp found-system pathname previous previous-time previous-primary)
(locate-system name)
(assert (eq foundp (and (or found-system pathname previous) t))))
(let ((previous-pathname (system-source-file previous))
......@@ -253,18 +256,18 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(setf (system-source-file system) pathname))
(if-let ((stamp (get-file-stamp pathname)))
(let ((up-to-date-p
(and previous
(and previous previous-primary
(or (pathname-equal pathname previous-pathname)
(and pathname previous-pathname
(pathname-equal
(physicalize-pathname pathname)
(physicalize-pathname previous-pathname))))
(timestamp<= stamp previous-time)
;; TODO: check that all dependencies are up-to-date.
;; This necessitates traversing them without triggering
;; the adding of nodes to the plan.
(or (not name-primary-p)
(definition-dependencies-up-to-date-p previous)))))
;; Check that all previous definition-dependencies are up-to-date,
;; traversing them without triggering the adding of nodes to the plan.
;; TODO: actually have a prepare-define-op, extract its timestamp,
;; and check that it is less than the stamp of the previous define-op ?
(definition-dependencies-up-to-date-p previous-primary))))
(unless up-to-date-p
(restart-case
(signal 'system-out-of-date :name name)
......
;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-
;;; This is ASDF 3.3.1: Another System Definition Facility.
;;; This is ASDF 3.3.1.3: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......
......@@ -126,21 +126,33 @@ a SYMBOL (designing its name, downcased), or a STRING (designing itself)."
(t (sysdef-error (compatfmt "~@<Invalid component designator: ~3i~_~A~@:>") name))))
(defun primary-system-name (system-designator)
"Given a system designator NAME, return the name of the corresponding primary system,
after which the .asd file is named. That's the first component when dividing the name
as a string by / slashes. A component designates its system."
"Given a system designator NAME, return the name of the corresponding
primary system, after which the .asd file in which it is defined is named.
If given a string or symbol (to downcase), do it syntactically
by stripping anything from the first slash on.
If given a component, do it semantically by extracting
the system-primary-system-name of its system."
(etypecase system-designator
(string (if-let (p (position #\/ system-designator))
(subseq system-designator 0 p) system-designator))
(symbol (primary-system-name (coerce-name system-designator)))
(component (primary-system-name (coerce-name (component-system system-designator))))))
(component (let* ((system (component-system system-designator))
(source-file (physicalize-pathname (system-source-file system))))
(and source-file
(equal (pathname-type source-file) "asd")
(pathname-name source-file))))))
(defun primary-system-p (system)
"Given a system designator SYSTEM, return T if it designates a primary system, or else NIL.
Also return NIL if system is neither a SYSTEM nor a string designating one."
(typecase system
If given a string, do it syntactically and return true if the name does not contain a slash.
If given a symbol, downcase to a string then fallback to previous case (NB: for NIL return T).
If given a component, do it semantically and return T if it's a SYSTEM and its primary-system-name
is the same as its component-name."
(etypecase system
(string (not (find #\/ system)))
(system (primary-system-p (coerce-name system)))))
(symbol (primary-system-p (coerce-name system)))
(component (and (typep system 'system)
(equal (component-name system) (primary-system-name system))))))
(defun coerce-filename (name)
"Coerce a system designator NAME into a string suitable as a filename component.
......
(in-package :test-package)
(assert *file1*)
(defparameter *file2* t)
(defvar *f2c* 0)
(incf *f2c*)
(in-package :asdf-test)
(assert (asymval '#:*file1* :test-package))
(assert (asymval '#:*file3* :test-package))
;; This broke at least when upgrading from 3.1.6-3.1.7 to 3.2.0-3.3.1
(assert-equal (asdf/bundle::gather-type (asdf:make-operation 'asdf:monolithic-lib-op)) :object)
(defparameter *properly-upgraded* t)
......@@ -366,12 +366,18 @@ upgrade_tags () {
# The 3.2 series provides the asdf3.2 feature, meaning users can rely on
# all its new features (launch-program, improved bundle support), as well as
# the improvements done in 3.1 (e.g. XDG support).
# 3.2.0 (2017-01-08) first (and latest) in 3.2 series
# 3.2.0 (2017-01-08) first in 3.2 series
# 3.2.1 (2017-04-03) bug fixes, second and last in 3.2 series
#
# The 3.3 series provides the asdf3.3 feature, meaning users can rely on
# all its new features (proper phase separation) as well as earlier features.
# 3.3.0 (2017-10-06) first in 3.3 series
# 3.3.1 (2017-11-14) bug fixes, second and latest in 3.3 series
#
# We return the above designated versions in order of decreasing relevance,
# which pretty much means REQUIRE and most recent first.
# We picked the last in each relevant series.
echo REQUIRE 3.3.0 3.2.1 3.2.0 3.1.7 3.1.2 3.0.3 2.26
# We picked the last and first in each relevant series, plus 2.26.
echo REQUIRE 3.3.1 3.3.0 3.2.1 3.2.0 3.1.7 3.1.2 3.0.3 2.26
#echo 3.1.7 3.1.6 3.1.5 3.1.4 3.1.3 3.1.2
#echo 3.0.3 3.0.2 3.0.1
......
......@@ -756,9 +756,9 @@ is bound, write a message and exit on an error. If
(acall (list new-method :asdf-test))
(format t "Testing it~%")
(register-directory *test-directory*)
(load-test-system :test-asdf/all)
(assert (asymval '#:*file1* :test-package))
(assert (asymval '#:*file3* :test-package))))
(load-test-system :test-asdf/upgrade)
(assert (symbol-value '*properly-upgraded*))))
(defun join-namestrings (namestrings)
(format nil (format nil "~~{~~A~~^~A~~}" (acall :inter-directory-separator)) namestrings))
......
......@@ -103,3 +103,9 @@
(defsystem "test-asdf/dep-can-appear"
:depends-on ("test-asdf-location-change")
:perform (load-op (o c) (incf *ta/dca*)))
(defsystem :test-asdf/upgrade
:version "0"
:depends-on (:test-asdf/all)
:components ((:file "properly-upgraded")))
......@@ -45,9 +45,25 @@
(DBG "Check that the files were indeed loaded.")
(assert (symbol-value (find-symbol* :*file1* :test-package)))
(assert (symbol-value (find-symbol* :*file3* :test-package)))
(DBG "Unintern symbols, load the bundle, and check that the symbols are there again.")
(set (find-symbol* :*file1* :test-package) nil)
(set (find-symbol* :*file3* :test-package) nil)
(assert-equal nil (symbol-value (find-symbol* :*file1* :test-package)))
(assert-equal nil (symbol-value (find-symbol* :*file3* :test-package)))
(load (output-file 'compile-bundle-op :test-asdf/bundle-1))
(assert-equal t (symbol-value (find-symbol* :*file1* :test-package)))
(assert-equal t (symbol-value (find-symbol* :*file3* :test-package)))
(DBG "Now for the mono-fasl")
(operate 'monolithic-compile-bundle-op :test-asdf/bundle-2)
(assert (probe-file *mono-bundle-2*))
(DBG "Unintern symbols, load the monolithic bundle, and check that the symbols are there again.")
(set (find-symbol* :*file1* :test-package) nil)
(set (find-symbol* :*file3* :test-package) nil)
(assert-equal nil (symbol-value (find-symbol* :*file1* :test-package)))
(assert-equal nil (symbol-value (find-symbol* :*file3* :test-package)))
(load (output-file 'monolithic-compile-bundle-op :test-asdf/bundle-2))
(assert-equal t (symbol-value (find-symbol* :*file1* :test-package)))
(assert-equal t (symbol-value (find-symbol* :*file3* :test-package)))
#+(or ecl mkcl)
(progn
......
;;; -*- Lisp -*-
(asdf:defsystem test-multiple
(defsystem test-multiple
:components
((:file "file3")))
(asdf:defsystem test-multiple-too
(defsystem test-multiple-too
:components
((:file "file1")
(:file "file2" :depends-on ("file1"))
(:file "file3" :depends-on ("file1" "file2"))))
(:file "file2" :depends-on ("file1"))))
(asdf:defsystem test-multiple-free
:depends-on (:test-multiple)
(defsystem test-multiple-free
:depends-on (:test-multiple :test-multiple-dep)
:components ((:file "file4")))
(defsystem test-multiple-dep
:depends-on (:test-multiple)
:components ((:file "file3")))
......@@ -7,19 +7,19 @@
(setf *central-registry* `(,*test-directory* ,tmp))
;; Don't rely on ln -s on Windows
(cond
((os-unix-p)
(multiple-value-bind (output error-output return-code)
(uiop:run-program
(format nil "ln -sf ~A ~A"
(native-namestring asd)
(native-namestring asd2)) :ignore-error-status t)
(declare (ignore output error-output))
(oos 'load-source-op (if (zerop return-code)
'test-multiple-too
'test-multiple))))
(t
(oos 'load-source-op 'test-multiple)))
(assert (asymval :*file3* :test-package))
(defparameter symlinkp
(progn
#+os-unix
(zerop
(nth-value 2
(run-program
`("ln" "-sf" ,(native-namestring asd) ,(native-namestring asd2))
:output t :error-output t :input nil :ignore-error-status t)))))
(oos 'load-source-op (if symlinkp 'test-multiple-too 'test-multiple))
(assert (asymval :*file2* :test-package))
(load-system 'test-multiple-free)
(assert (probe-file* file4))
(assert (asymval :*file4* :test-package))
(setf test-package::*file4* nil)
(load-system 'test-multiple-free)
(assert-equal test-package::*file4* nil)
......@@ -108,7 +108,7 @@ a command-line executable for LispWorks this way: