...
 
Commits (42)
......@@ -49,6 +49,7 @@ test/try-reloading-dependency.asd
test/fileMissing.lisp
test/hello-world-example
test/test-include.asd
test/test-multiple-too.asd
build-stamp
......@@ -67,5 +68,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.2.2" ;; to be automatically updated by make bump-version
:depends-on ()
#+asdf3 :encoding #+asdf3 :utf-8
:class #+asdf3.1 package-inferred-system #-asdf3.1 system
......
(in-package :asdf)
(defclass fiveam-tester-system (system)
((test-names
:initarg :test-names
:reader test-names
:documentation "A list whose elments are either
cons cells of symbol and package designators or
simply a symbol designator.
In the latter case, the symbols will be interned
in the package designated by the TEST-PACKAGE slot,
which must be bound.")
(test-package
:initarg :default-test-package
:initarg :test-package
:documentation "If all the tests are in one package, you can just
have a list of test names in test-names, and get the package name from
here.")
(num-checks
:initarg :num-checks
:reader num-checks
:type (or null (integer 0))
:initform nil
:documentation "How many tests do you expect to run when
you invoke the test-op on this system. For backwards compatibility,
this slot is ignored if it's NIL. If bound, then when running the
test-op, we will fail if the expected number of checks are not run.")
))
(define-condition fiveam-asdf-failure (error)
((failed-asdf-component
:initarg :failed-asdf-component
:reader failed-asdf-component
))
(:documentation "Superclass of error conditions that indicate that
an ASDF test-op has failed."))
(define-condition fiveam-test-fail (fiveam-asdf-failure)
((failed
:initarg :failed
:reader failed
))
(:report (lambda (x s)
(format s "Tests on system ~a failed: ~{~t~a~%~}"
(component-name (failed-asdf-component x))
(failed x)))))
(define-condition fiveam-wrong-number-of-checks (fiveam-asdf-failure)
((expected-num-checks
:initarg :expected
:initarg :expected-num-checks
:reader expected-num-checks
)
(actual-num-checks
:initarg :actual-num-checks
:initarg :actual
:reader actual-num-checks
))
(:report (lambda (x s)
(format s "Unexpected number of tests on system ~a: Expected ~d got ~d."
(component-name (failed-asdf-component x))
(expected-num-checks x)
(actual-num-checks x)))))
(defgeneric test-package (x)
(:method ((x fiveam-tester-system))
(if (slot-boundp x 'test-package)
(slot-value x 'test-package)
(error "If package is not specified with each test-name, system's TEST-PACKAGE slot must be set."))))
(defmethod perform ((op test-op) (sys fiveam-tester-system))
(let* ((test-syms
(loop for x in (test-names sys)
with test-name and package-name and test-sym and package
if (symbolp x)
do (setf test-name x
package-name (test-package sys))
else
do (assert (and (consp x)
(or (symbolp (car x)) (stringp (car x)))
(or (symbolp (cdr x)) (stringp (cdr x)))))
(setf test-name (car x) package-name (cdr x))
do (setf package (or (find-package package-name)
(error "Unable to find package ~a" package-name)))
(setf test-sym
(intern
(etypecase test-name
(string test-name)
(symbol (symbol-name test-name)))
package))
collect test-sym))
(runner (intern (symbol-name '#:run) :fiveam))
(tester (intern (symbol-name '#:results-status) :fiveam))
(explainer (intern (symbol-name '#:explain!) :fiveam))
(results (loop for test in test-syms
appending (funcall runner test))))
(funcall explainer results)
;; if there's an expected number of checks, verify that we have run
;; exactly that number.
(when (num-checks sys)
(let ((actual-num-checks (length results)))
(unless (= actual-num-checks (num-checks sys))
(error 'fiveam-wrong-number-of-checks
:failed-asdf-component sys
:actual actual-num-checks
:expected (num-checks sys)))))
(multiple-value-bind (success failures)
(funcall tester results)
(unless success
(error 'fiveam-test-fail :failed-asdf-component sys :failed failures)))))
(defmethod component-depends-on ((op load-op) (sys fiveam-tester-system))
(cons '(load-op "fiveam") (call-next-method)))
(defmethod component-depends-on ((op compile-op) (sys fiveam-tester-system))
(cons '(load-op "fiveam") (call-next-method)))
(eval-when (:compile-toplevel :load-toplevel :execute)
(export 'fiveam-tester-system :asdf))
;;;---------------------------------------------------------------------------
;;; Copyright (c) 2012-2018 Smart Information Flow Technologies, d/b/a SIFT, LLC and
;;; Robert P. Goldman
;;; All rights reserved.
;;;
;;; The developers make this software available according to the terms
;;; of the Lisp Lesser GNU Public License (LLGPL):
;;; http://opensource.franz.com/preamble.html.
;;; See the accompanying file, license.txt
;;;
;;;---------------------------------------------------------------------------
;;;
;;; This system provides functionality to support integrating FiveAM tests with
;;; an ASDF system definition in such a way that invocation of the
;;; ASDF:TEST-SYSTEM function will cause the FiveAM tests to run. An error will
;;; be raised if there are test failures.
;;;
;;;---------------------------------------------------------------------------
(defpackage :fiveam-asdf-asd
(:use :common-lisp :asdf)
)
(in-package :fiveam-asdf-asd)
(defsystem fiveam-asdf
:long-description
"System that defines a new system class FIVEAM-TESTER
that provides functionality for running tests using
FIVEAM and raising an error if the tests fail
\(useful for incorporation in a Jenkins or Hudson
build\)."
:depends-on (:asdf)
:components ((:file "code"))
:author "Robert P. Goldman"
:version "2.0"
:license "Lisp LGPL"
)
FIVEAM-ASDF is a library enabling suites of FiveAM tests to be
associated with ASDF systems in such a way that ASDF:TEST-SYSTEM will
cause the tests to be run and will raise an exception if something
unexpected happens.
FIVEAM-ASDF is licensed under the terms of the Lisp Lesser GNU
Public License (http://opensource.franz.com/preamble.html), known as
the LLGPL. The LLGPL consists of a preamble (see above URL) and the
LGPL. Where these conflict, the preamble takes precedence.
FIVEAM-ASDF is referenced in the preamble as the "LIBRARY."
cl-asdf (2:3.3.2-1) unstable; urgency=low
Bug fix release:
* Dependency tracking: fix bugs in handling misnamed secondary systems.
We now distinguish between "syntactic" and "semantic" primariness,
properly warn in case a secondary system is misnamed, yet properly
recompile or avoid spurious recompilation depending on whether
there or not is a conflict or redefinition.
Similarly handle package-inferred-system (thanks to Eric Timmons).
Better warning in a fishy case of compute-action-stamp.
* UIOP: Add package location information to define-package on SBCL.
* Upgrade: fix issue with asdf/bundle.
* Portability: add support for Mezzano (thanks to E. Housel, H. Harrington)
* Documentation: add discussion of best practices.
* Package-inferred system: Improve source file handling.
* Test and documentation improvements.
-- Francois-Rene Rideau <fare@tunes.org> Thu, 03 May 2018 22:46:19 -0400
cl-asdf (2:3.3.1-1) unstable; urgency=low
New milestone:
......@@ -12,7 +31,7 @@ cl-asdf (2:3.3.1-1) unstable; urgency=low
* Tests: tests for new capabilities and bugs
* Documentation: a number of improvements and clarifications.
-- Robert P. Goldman <rpgoldman@sift.net> Sun, 12 Nov 2017 17:39:04 -0600
-- Robert P. Goldman <rpgoldman@sift.net> Sun, 12 Nov 2017 17:39:04 -0600
cl-asdf (2:3.3.0-1) unstable; urgency=low
......@@ -49,7 +68,7 @@ cl-asdf (2:3.3.0-1) unstable; urgency=low
* Deprecation: starting to emit STYLE-WARNINGs for deprecated
functions. Will gradually escalate to true WARNINGs and then ERRORs.
-- Robert P. Goldman <rpgoldman@sift.net> Sun, 20 August 2017 21:00:00 -0500
-- Robert P. Goldman <rpgoldman@sift.net> Sun, 20 August 2017 21:00:00 -0500
cl-asdf (2:3.2.1-1) unstable; urgency=low
......
......@@ -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.2.2
@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.2.2
@end ifnottex
......
......@@ -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.
......@@ -44,8 +44,8 @@
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,
3.2.0 on January 10th 2017 and 3.3.0 on October 6th 2017,
and latest release 3.3.1 on November 4th 2017.
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>
......@@ -322,6 +322,7 @@
<a href="http://clisp.org/">CLISP</a>,
<a href="http://cmucl.org/">CMUCL</a>,
<a href="https://common-lisp.net/project/ecl/" title="Embeddable Common Lisp">ECL</a>,
<a href="https://github.com/froggey/Mezzano/" title="Mezzano">Mezzano</a>,
<a href="https://common-lisp.net/project/mkcl/" title="ManKai Common Lisp">MKCL</a>,
<a href="http://www.sbcl.org/" title="Steel Bank Common Lisp">SBCL</a>
</td>
......@@ -330,14 +331,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,
......
......@@ -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.
Today we release ASDF 3.3.2, the second bugfix release for the 3.3 release series. Of primary interest in this release are
1. Multiple fixes in handling misnamed (or "legacy-named," if you prefer) secondary systems ("foo-test" instead of "foo/test"). Thanks to Eric Timmons, there is also a similar fix for package-inferred-systems.
2. Fix an annoying warning message for compute-action-stamp.
3. Add support for the Mezzano implementation (thanks to E. Housel, H. Harrington).
4. Miscellaneous minor fixes and documentation tweaks.
We urge implementations that are currently bundling previous versions of ASDF -- and especially those bundling 3.3.0 or 3.3.1 -- to upgrade to 3.3.2 at their earliest convenience.
Immense thanks, as always, to Fare Rideau. Also thanks to the many bug reporters and patch submitters (see the Changelog), and to Anton Vodonosov and Dave Cooper for help with testing.
Here is the changelog entry for 3.3.2:
cl-asdf (2:3.3.2-1) unstable; urgency=low
Bug fix release:
* Dependency tracking: fix bugs in handling misnamed secondary systems.
We now distinguish between "syntactic" and "semantic" primariness,
properly warn in case a secondary system is misnamed, yet properly
recompile or avoid spurious recompilation depending on whether
there or not is a conflict or redefinition.
Similarly handle package-inferred-system (thanks to Eric Timmons).
Better warning in a fishy case of compute-action-stamp.
* UIOP: Add package location information to define-package on SBCL.
* Upgrade: fix issue with asdf/bundle.
* Portability: add support for Mezzano (thanks to E. Housel, H. Harrington)
* Documentation: add discussion of best practices.
* Package-inferred system: Improve source file handling.
* Test and documentation improvements.
-- Francois-Rene Rideau <fare@tunes.org> Thu, 03 May 2018 22:46:19 -0400
......@@ -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)))))
(let ((readtable *readtable*) ;; save outer syntax tables. TODO: proper syntax-control
......@@ -195,21 +193,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
......@@ -222,37 +224,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))
......@@ -263,18 +266,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)
......
......@@ -7,10 +7,10 @@
:asdf/system ;; used by ECL
:asdf/upgrade :asdf/system-registry :asdf/operate :asdf/bundle)
;; Happily, all those implementations all have the same module-provider hook interface.
#+(or abcl clasp cmucl clozure ecl mkcl sbcl)
(:import-from #+abcl :sys #+(or clasp cmucl ecl) :ext #+clozure :ccl #+mkcl :mk-ext #+sbcl sb-ext
#:*module-provider-functions*
#+ecl #:*load-hooks*)
#+(or abcl clasp cmucl clozure ecl mezzano mkcl sbcl)
(:import-from #+abcl :sys #+(or clasp cmucl ecl) :ext #+clozure :ccl #+mkcl :mk-ext #+sbcl sb-ext #+mezzano :sys.int
#:*module-provider-functions*
#+ecl #:*load-hooks*)
#+(or clasp mkcl) (:import-from :si #:*load-hooks*))
(in-package :asdf/footer)
......@@ -24,7 +24,7 @@
;;;; Hook ASDF into the implementation's REQUIRE and other entry points.
#+(or abcl clasp clisp clozure cmucl ecl mkcl sbcl)
#+(or abcl clasp clisp clozure cmucl ecl mezzano mkcl sbcl)
(with-upgradability ()
;; Hook into CL:REQUIRE.
#-clisp (pushnew 'module-provide-asdf *module-provider-functions*)
......@@ -44,15 +44,15 @@
(setf (gethash 'module-provide-asdf *wrapped-module-provider*) 'module-provide-asdf)
(defun wrap-module-provider (provider name)
(let ((results (multiple-value-list (funcall provider name))))
(when (first results) (register-preloaded-system (coerce-name name)))
(values-list results)))
(when (first results) (register-preloaded-system (coerce-name name)))
(values-list results)))
(defun wrap-module-provider-function (provider)
(ensure-gethash provider *wrapped-module-provider*
(constantly
#'(lambda (module-name)
(wrap-module-provider provider module-name)))))
(constantly
#'(lambda (module-name)
(wrap-module-provider provider module-name)))))
(setf *module-provider-functions*
(mapcar #'wrap-module-provider-function *module-provider-functions*))))
(mapcar #'wrap-module-provider-function *module-provider-functions*))))
#+cmucl ;; Hook into the CMUCL herald.
(with-upgradability ()
......
;;; -*- 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.2.2: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......
......@@ -138,7 +138,7 @@ otherwise return a default system name computed from PACKAGE-NAME."
previous
(eval `(defsystem ,system
:class package-inferred-system
:source-file nil
:source-file ,(system-source-file top)
:pathname ,dir
:depends-on ,dependencies
:around-compile ,around-compile
......
......@@ -187,8 +187,11 @@ Please only define ~S and secondary systems with a name starting with ~S (e.g. ~
:for name = (and (keywordp key) (find key +asdf-methods+ :test 'string=))
:when name :do
(destructuring-bind (op &rest body) value
(when (or (not (symbolp op))
(not (find-if #'consp body))) ; must contain non-empty lambda list
(sysdef-error "Ill-formed inline method: ~S" value))
(loop :for arg = (pop body)
:while (atom arg)
:while (atom arg) ; guaranteed to terminate due to (find-if #'consp ...)
:collect arg :into qualifiers
:finally
(destructuring-bind (o c) arg
......
......@@ -246,6 +246,24 @@ initialized with SEED."
;; so they need not refer to the state of the filesystem,
;; and the stamps could be cryptographic checksums rather than timestamps.
;; Such a change remarkably would only affect COMPUTE-ACTION-STAMP.
(define-condition dependency-not-done (warning)
((op
:initarg :op)
(component
:initarg :component)
(dep-op
:initarg :dep-op)
(dep-component
:initarg :dep-component)
(plan
:initarg :plan
:initform nil))
(:report (lambda (condition stream)
(with-slots (op component dep-op dep-component plan) condition
(format stream "Computing just-done stamp ~@[in plan ~S~] for action ~S, but dependency ~S wasn't done yet!"
plan
(action-path (make-action op component))
(action-path (make-action dep-op dep-component)))))))
(defmethod compute-action-stamp (plan (o operation) (c component) &key just-done)
;; Given an action, figure out at what time in the past it has been done,
......@@ -279,10 +297,10 @@ initialized with SEED."
(just-done
;; It's OK to lose some ASDF action stamps during self-upgrade
(unless (equal "asdf" (primary-system-name dc))
(warn "Computing just-done stamp in plan ~S for action ~S, but dependency ~S wasn't done yet!"
plan
(action-path (make-action o c))
(action-path (make-action do dc))))
(warn 'dependency-not-done
:plan plan
:op o :component c
:dep-op do :dep-component dc))
status)
(t
(return (values nil nil))))))
......
......@@ -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.
......
......@@ -464,7 +464,9 @@
(assert (directory-pathname-p (system-source-directory (find-system :test-asdf/test-source-directory-2))))
#-gcl ;; expected-failure: GCL crashes badly
(assert (test-component-pathnames :delete-host t :support-string-pathnames nil))
(assert
(handler-bind ((bad-system-name #'(lambda (c) (muffle-warning c))))
(test-component-pathnames :delete-host t :support-string-pathnames nil)))
#+os-unix
(test-pathname-parsing)
......
(in-package :test-package)
(assert *file1*)
(defparameter *file2* t)
(defvar *f2c* 0)
(incf *f2c*)
......@@ -12,3 +12,7 @@
;; Test that around-compile is inherited by inferred systems.
(assert-equal 3 (symbol-call :package-inferred-system-test/a :add10 1)) ;; add10 must have been compiled in base 2
;; Test that primary system name returns the correct value when called with a
;; package-inferred-system object.
(assert-equal "package-inferred-system-test" (primary-system-name (find-system :package-inferred-system-test/a/x)))
......@@ -232,7 +232,7 @@ case "$lisp" in
# as the corresponding executables. the "build" executable
# runs an ACL image in the current terminal instead of a
# separate window, as is normal on Windows.
bcmd="${adir}/${build}.exe -I ${command}.dxl $flags" ;
bcmd="${adir}/${build}.exe -I ${adir}/${allegroName}.dxl $flags" ;
fi
eval="-e" ;;
ccl)
......
;;; -*- 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")))
;;; -*- Lisp -*-
(defparameter asd (subpathname *test-directory* "test-multiple.asd"))
(defparameter tmp (subpathname *test-directory* "../build/"))
(defparameter asd2 (subpathname tmp "test-multiple-too.asd"))
(defparameter asd2 (subpathname *test-directory* "test-multiple-too.asd"))
(defparameter file4 (test-fasl "file4"))
(setf *central-registry* `(,*test-directory* ,tmp))
(setf *central-registry* `(,*test-directory*))
;; 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))
(load-system 'test-multiple-free)
(assert (probe-file* file4))
;; Don't rely on ln -s because of Windows.
;; Also allows pathname tests to distinguish between asd and asd2
(delete-file-if-exists asd2)
(concatenate-files (list asd) asd2) ;; don't use copy-file, to ensure the timestamp of asd2 is newer.
(defmacro with-bad-system-names (&body body)
`(handler-bind ((bad-system-name #'(lambda (c) (muffle-warning c))))
,@body))
(with-asdf-session ()
(DBG "Loading test-multiple-too, a copy of test-multiple")
(with-bad-system-names
(oos 'load-source-op 'test-multiple-too))
(assert (asymval :*file2* :test-package))
(assert (not (asymval :*file4* :test-package))) ;; file4 from test-multiple-free is not loaded
;; All systems loaded from test-multiple-too.asd
(assert-pathname-equal (system-source-file (registered-system 'test-multiple)) asd2)
(assert-pathname-equal (system-source-file (registered-system 'test-multiple-too)) asd2)
(assert-pathname-equal (system-source-file (registered-system 'test-multiple-dep)) asd2)
(assert-pathname-equal (system-source-file (registered-system 'test-multiple-free)) asd2))
(with-asdf-session ()
(DBG "Loading test-multiple-free, a badly named secondary system that depends on test-multiple (that was loaded as badly named from test-multiple-too). It shouldn't be found by path, so the existing definition will be used, which will pull test-multiple, which will in turn override test-multiple-too, but test-multiple-free will be locked to the value at the beginning of the session, which uses test-multiple-too.asd (ouch).")
(with-bad-system-names
(load-system 'test-multiple-free))
(assert (probe-file* file4))
(assert (asymval :*file4* :test-package)) ;; file4 from test-multiple-free is loaded
;; All systems loaded from test-multiple.asd except test-multiple-free stuck with test-multiple-too.asd
(assert-pathname-equal (system-source-file (registered-system 'test-multiple)) asd)
(assert-pathname-equal (system-source-file (registered-system 'test-multiple-too)) asd)
(assert-pathname-equal (system-source-file (registered-system 'test-multiple-dep)) asd)
(assert-pathname-equal (system-source-file (registered-system 'test-multiple-free)) asd2))
(with-asdf-session ()
(DBG "Loading test-multiple-free again. [I admit I don't fully understand the behavior -fare]")
(setf test-package::*file4* nil)
(with-bad-system-names
(DBG :l (asdf/plan:plan-actions (nth-value 1 (oos 'load-op 'test-multiple-free)))))
;; All systems loaded from test-multiple-too.asd [I'm not sure why; it may have to do with timestamp (!) -fare]
(assert-pathname-equal (system-source-file (registered-system 'test-multiple)) asd2)
(assert-pathname-equal (system-source-file (registered-system 'test-multiple-too)) asd2)
(assert-pathname-equal (system-source-file (registered-system 'test-multiple-dep)) asd2)
(assert-pathname-equal (system-source-file (registered-system 'test-multiple-free)) asd2)
;; The above unexpected reloading of asd causes file4 to be reloaded
(assert-equal test-package::*file4* t))
......@@ -108,7 +108,7 @@ a command-line executable for LispWorks this way:
(defun install-asdf-as-module ()
(nest
(let* ((asdf.lisp (system-relative-pathname :uiop "../build/asdf.lisp"))
(let* ((asdf.lisp (subpathname *asdf-dir* "build/asdf.lisp"))
(asdf.fasl (asdf-module-fasl))
#+(or clasp ecl mkcl) (asdf.o (object-file asdf.fasl :object))
#+(or clasp ecl mkcl) (asdf.a (object-file asdf.fasl :lib))))
......
......@@ -21,7 +21,7 @@
#+(or mcl cmucl) (:shadow #:user-homedir-pathname))
(in-package :uiop/common-lisp)
#-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
#-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mezzano mkcl sbcl scl xcl)
(error "ASDF is not supported on your implementation. Please help us port it.")
;; (declaim (optimize (speed 1) (debug 3) (safety 3))) ; DON'T: trust implementation defaults.
......@@ -29,7 +29,7 @@
;;;; Early meta-level tweaks
#+(or allegro clasp clisp clozure cmucl ecl mkcl sbcl)
#+(or allegro clasp clisp clozure cmucl ecl mezzano mkcl sbcl)
(eval-when (:load-toplevel :compile-toplevel :execute)
(when (and #+allegro (member :ics *features*)
#+(or clasp clisp cmucl ecl mkcl) (member :unicode *features*)
......
......@@ -139,6 +139,9 @@ This is designed to abstract away the implementation specific quit forms."
(dbg:*debug-print-level* *print-level*)
(dbg:*debug-print-length* *print-length*))
(dbg:bug-backtrace nil))
#+mezzano
(let ((*standard-output* stream))
(sys.int::backtrace count))
#+sbcl
(sb-debug:print-backtrace :stream stream :count (or count most-positive-fixnum))
#+xcl
......@@ -227,12 +230,12 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die"
#+clozure ccl:*command-line-argument-list*
#+(or cmucl scl) extensions:*command-line-strings*
#+gcl si:*command-args*
#+(or genera mcl) nil
#+(or genera mcl mezzano) nil
#+lispworks sys:*line-arguments-list*
#+mkcl (loop :for i :from 0 :below (mkcl:argc) :collect (mkcl:argv i))
#+sbcl sb-ext:*posix-argv*
#+xcl system:*argv*
#-(or abcl allegro clasp clisp clozure cmucl ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
#-(or abcl allegro clasp clisp clozure cmucl ecl gcl genera lispworks mcl mezzano mkcl sbcl scl xcl)
(not-implemented-error 'raw-command-line-arguments))
(defun command-line-arguments (&optional (arguments (raw-command-line-arguments)))
......
......@@ -342,12 +342,28 @@ Simple means made of symbols, numbers, characters, simple-strings, pathnames, co
(sb-c::undefined-warning-kind warning)
(sb-c::undefined-warning-name warning)
(sb-c::undefined-warning-count warning)
;; the COMPILER-ERROR-CONTEXT struct has changed in SBCL, which means how we
;; handle deferred warnings must change... TODO: when enough time has
;; gone by, just assume all versions of SBCL are adequately
;; up-to-date, and cut this material.[2018/05/30:rpg]
(mapcar
#'(lambda (frob)
;; the lexenv slot can be ignored for reporting purposes
`(:enclosing-source ,(sb-c::compiler-error-context-enclosing-source frob)
:source ,(sb-c::compiler-error-context-source frob)
:original-source ,(sb-c::compiler-error-context-original-source frob)
`(
#- #.(uiop/utility:symbol-test-to-feature-expression '#:compiler-error-context-%source '#:sb-c)
,@`(:enclosing-source
,(sb-c::compiler-error-context-enclosing-source frob)
:source
,(sb-c::compiler-error-context-source frob)
:original-source
,(sb-c::compiler-error-context-original-source frob))
#+ #.(uiop/utility:symbol-test-to-feature-expression '#:compiler-error-context-%source '#:sb-c)
,@ `(:%enclosing-source
,(sb-c::compiler-error-context-enclosing-source frob)
:%source
,(sb-c::compiler-error-context-source frob)
:original-form
,(sb-c::compiler-error-context-original-form frob))
:context ,(sb-c::compiler-error-context-context frob)
:file-name ,(sb-c::compiler-error-context-file-name frob) ; a pathname
:file-position ,(sb-c::compiler-error-context-file-position frob) ; an integer
......
......@@ -59,6 +59,10 @@ keywords explicitly."
"Is the underlying operating system Haiku?"
(featurep :haiku))
(defun os-mezzano-p ()
"Is the underlying operating system Mezzano?"
(featurep :mezzano))
(defun detect-os ()
"Detects the current operating system. Only needs be run at compile-time,
except on ABCL where it might change between FASL compilation and runtime."
......@@ -66,7 +70,8 @@ except on ABCL where it might change between FASL compilation and runtime."
:for (feature . detect) :in '((:os-unix . os-unix-p) (:os-macosx . os-macosx-p)
(:os-windows . os-windows-p)
(:genera . os-genera-p) (:os-oldmac . os-oldmac-p)
(:haiku . os-haiku-p))
(:haiku . os-haiku-p)
(:mezzano . os-mezzano-p))
:when (and (or (not o) (eq feature :os-macosx)) (funcall detect))
:do (setf o feature) (pushnew feature *features*)
:else :do (setf *features* (remove feature *features*))
......@@ -103,7 +108,7 @@ use getenvp to return NIL in such a case."
(ct:free buffer)
(ct:free buffer1)))
#+gcl (system:getenv x)
#+genera nil
#+(or genera mezzano) nil
#+lispworks (lispworks:environment-variable x)
#+mcl (ccl:with-cstrs ((name x))
(let ((value (_getenv name)))
......@@ -111,7 +116,7 @@ use getenvp to return NIL in such a case."
(ccl:%get-cstring value))))
#+mkcl (#.(or (find-symbol* 'getenv :si nil) (find-symbol* 'getenv :mk-ext nil)) x)
#+sbcl (sb-ext:posix-getenv x)
#-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
#-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mezzano mkcl sbcl scl xcl)
(not-implemented-error 'getenv))
(defsetf getenv (x) (val)
......@@ -157,7 +162,7 @@ then returning the non-empty string value of the variable"
'(:abcl (:acl :allegro) (:ccl :clozure) :clisp (:corman :cormanlisp)
(:cmu :cmucl :cmu) :clasp :ecl :gcl
(:lwpe :lispworks-personal-edition) (:lw :lispworks)
:mcl :mkcl :sbcl :scl (:smbx :symbolics) :xcl)))
:mcl :mezzano :mkcl :sbcl :scl (:smbx :symbolics) :xcl)))
(defvar *implementation-type* (implementation-type)
"The type of Lisp implementation used, as a short UIOP-standardized keyword")
......@@ -172,7 +177,8 @@ then returning the non-empty string value of the variable"
(:solaris :solaris :sunos)
(:bsd :bsd :freebsd :netbsd :openbsd :dragonfly)
:unix
:genera)))
:genera
:mezzano)))
(defun architecture ()
"The CPU architecture of the current host"
......@@ -230,6 +236,9 @@ then returning the non-empty string value of the variable"
(multiple-value-bind (major minor) (sct:get-system-version "System")
(format nil "~D.~D" major minor))
#+mcl (subseq s 8) ; strip the leading "Version "
#+mezzano (format nil "~A-~D"
(subseq s 0 (position #\space s)) ; strip commit hash
sys.int::*llf-version*)
;; seems like there should be a shorter way to do this, like ACALL.
#+mkcl (or
(let ((fname (find-symbol* '#:git-describe-this-mkcl :mkcl nil)))
......@@ -255,7 +264,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie
(with-upgradability ()
(defun hostname ()
"return the hostname of the current host"
#+(or abcl clasp clozure cmucl ecl genera lispworks mcl mkcl sbcl scl xcl) (machine-instance)
#+(or abcl clasp clozure cmucl ecl genera lispworks mcl mezzano mkcl sbcl scl xcl) (machine-instance)
#+cormanlisp "localhost" ;; is there a better way? Does it matter?
#+allegro (symbol-call :excl.osi :gethostname)
#+clisp (first (split-string (machine-instance) :separator " "))
......@@ -275,7 +284,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie
(defun getcwd ()
"Get the current working directory as per POSIX getcwd(3), as a pathname object"
(or #+(or abcl genera xcl) (truename *default-pathname-defaults*) ;; d-p-d is canonical!
(or #+(or abcl genera mezzano xcl) (truename *default-pathname-defaults*) ;; d-p-d is canonical!
#+allegro (excl::current-directory)
#+clisp (ext:default-directory)
#+clozure (ccl:current-directory)
......@@ -293,7 +302,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie
(defun chdir (x)
"Change current directory, as per POSIX chdir(2), to a given pathname object"
(if-let (x (pathname x))
#+(or abcl genera xcl) (setf *default-pathname-defaults* (truename x)) ;; d-p-d is canonical!
#+(or abcl genera mezzano xcl) (setf *default-pathname-defaults* (truename x)) ;; d-p-d is canonical!
#+allegro (excl:chdir x)
#+clisp (ext:cd x)
#+clozure (setf (ccl:current-directory) x)
......
......@@ -700,13 +700,13 @@ or when loading the package is optional."
:and :do (setf use-p t) :else
:when (eq kw :unintern) :append args :into unintern :else
:do (error "unrecognized define-package keyword ~S" kw)
:finally (return `(,package
:nicknames ,nicknames :documentation ,documentation
:use ,(if use-p use '(:common-lisp))
:shadow ,shadow :shadowing-import-from ,shadowing-import-from
:import-from ,import-from :export ,export :intern ,intern
:recycle ,(if recycle-p recycle (cons package nicknames))
:mix ,mix :reexport ,reexport :unintern ,unintern)))))
:finally (return `(',package
:nicknames ',nicknames :documentation ',documentation
:use ',(if use-p use '(:common-lisp))
:shadow ',shadow :shadowing-import-from ',shadowing-import-from
:import-from ',import-from :export ',export :intern ',intern
:recycle ',(if recycle-p recycle (cons package nicknames))
:mix ',mix :reexport ',reexport :unintern ',unintern)))))
(defmacro define-package (package &rest clauses)
"DEFINE-PACKAGE takes a PACKAGE and a number of CLAUSES, of the form
......@@ -732,7 +732,10 @@ export symbols with the same name as those exported from p. Note that in the ca
of shadowing, etc. the symbols with the same name may not be the same symbols.
UNINTERN -- Remove symbols here from PACKAGE."
(let ((ensure-form
`(apply 'ensure-package ',(parse-define-package-form package clauses))))
`(prog1
(funcall 'ensure-package ,@(parse-define-package-form package clauses))
#+sbcl (setf (sb-impl::package-source-location (find-package ',package))
(sb-c:source-location)))))
`(progn
#+(or clasp ecl gcl mkcl) (defpackage ,package (:use))
(eval-when (:compile-toplevel :load-toplevel :execute)
......
......@@ -92,7 +92,7 @@ by the underlying implementation's MAKE-PATHNAME and other primitives"
;; This will be :unspecific if supported, or NIL if not.
(defparameter *unspecific-pathname-type*
#+(or abcl allegro clozure cmucl genera lispworks sbcl scl) :unspecific
#+(or clasp clisp ecl mkcl gcl xcl #|These haven't been tested:|# cormanlisp mcl) nil
#+(or clasp clisp ecl mkcl gcl xcl #|These haven't been tested:|# cormanlisp mcl mezzano) nil
"Unspecific type component to use with the underlying implementation's MAKE-PATHNAME")
(defun make-pathname* (&rest keys &key directory host device name type version defaults
......
......@@ -35,7 +35,9 @@
#:simple-style-warning #:style-warn ;; simple style warnings
#:match-condition-p #:match-any-condition-p ;; conditions
#:call-with-muffled-conditions #:with-muffled-conditions
#:not-implemented-error #:parameter-error))
#:not-implemented-error #:parameter-error
#:symbol-test-to-feature-expression
#:boolean-to-feature-expression))
(in-package :uiop/utility)
;;;; Defining functions in a way compatible with hot-upgrade:
......@@ -650,3 +652,15 @@ message, that takes the functionality as its first argument (that can be skipped
:format-control format-control
:format-arguments format-arguments)))
(with-upgradability ()
(defun boolean-to-feature-expression (value)
"Converts a boolean VALUE to a form suitable for testing with #+."
(if value
'(:and)
'(:or)))
(defun symbol-test-to-feature-expression (name package)
"Check if a symbol with a given NAME exists in PACKAGE and returns a
form suitable for testing with #+."
(boolean-to-feature-expression
(find-symbol* name package nil))))
......@@ -12,7 +12,7 @@
(in-package :uiop/version)
(with-upgradability ()
(defparameter *uiop-version* "3.3.1")
(defparameter *uiop-version* "3.3.2.2")
(defun unparse-version (version-list)
"From a parsed version (a list of natural numbers), compute the version string"
......
......@@ -94,7 +94,7 @@ previously-loaded version of ASDF."
;; "3.4.5.67" would be a development version in the official branch, on top of 3.4.5.
;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
(asdf-version "3.3.1")
(asdf-version "3.3.2.2")
(existing-version (asdf-version)))
(setf *asdf-version* asdf-version)
(when (and existing-version (not (equal asdf-version existing-version)))
......