diff --git a/asdf.asd b/asdf.asd index 8f81840ef293669a6ee1a86af57a8babb006c741..ad379da3eb66a15191e446be2cab7a431a045a33 100644 --- a/asdf.asd +++ b/asdf.asd @@ -75,7 +75,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "3.1.2.4" ;; to be automatically updated by make bump-version + :version "3.1.3" ;; to be automatically updated by make bump-version :depends-on () #+asdf3 :encoding #+asdf3 :utf-8 :class #.(if (find-class 'package-inferred-system nil) 'package-inferred-system 'system) diff --git a/cache.lisp b/cache.lisp index dac44e2f17a4b2ea8d7dfe14bceb36c331f4ff0a..1d15e40da146c9002e5b4545e714527089570b71 100644 --- a/cache.lisp +++ b/cache.lisp @@ -5,8 +5,9 @@ (:use :uiop/common-lisp :uiop :asdf/upgrade) (:export #:get-file-stamp #:compute-file-stamp #:register-file-stamp #:set-asdf-cache-entry #:unset-asdf-cache-entry #:consult-asdf-cache - #:do-asdf-cache #:normalize-namestring - #:call-with-asdf-cache #:with-asdf-cache #:*asdf-cache*)) + #:do-asdf-cache #:normalize-namestring + #:call-with-asdf-cache #:with-asdf-cache #:*asdf-cache* + #:clear-configuration-and-retry #:retry)) (in-package :asdf/cache) ;;; This stamp cache is useful for: @@ -42,8 +43,17 @@ (let ((fun (if key #'(lambda () (consult-asdf-cache key thunk)) thunk))) (if (and *asdf-cache* (not override)) (funcall fun) - (let ((*asdf-cache* (make-hash-table :test 'equal))) - (funcall fun))))) + (loop + (restart-case + (let ((*asdf-cache* (make-hash-table :test 'equal))) + (return (funcall fun))) + (retry () + :report (lambda (s) + (format s (compatfmt "~@<Retry ASDF operation.~@:>")))) + (clear-configuration-and-retry () + :report (lambda (s) + (format s (compatfmt "~@<Retry ASDF operation after resetting the configuration.~@:>"))) + (clear-configuration))))))) (defmacro with-asdf-cache ((&key key override) &body body) `(call-with-asdf-cache #'(lambda () ,@body) :override ,override :key ,key)) diff --git a/debian/changelog b/debian/changelog index 66a61b19137935d5f7ecba12e06f3e17541d2982..6da5ad6c2d2ef2008802c2787880532787a40663 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,4 +1,18 @@ -cl-asdf (2:3.1.2-1) unstable; urgency=low +cl-asdf (2:3.1.3-1) unstable; urgency=low + + Bug fix release: + * A bug in 3.1.2 caused errors when hot-upgrading from 3.1.2 ASDF. + * Fix bugs in ASDF component search caching. In some circumstances, + aggressive caching (particularly of negative results) interfered with + error-handling through restarts. Also, in some cases use of caching + interfered with error-checking. Some of these issues are discussed in + ticket #1335323 on launchpad. + * Miscellaneous bug fixes and tweaks to UIOP. + * Documentation improvements. + + -- Francois-Rene Rideau <fare@tunes.org> Thu, 24 Jul 2014 12:48:29 -0400 + +cl-asdf (2:3.1.2-2) unstable; urgency=low New release: * ~/common-lisp/ is now present by default in the source-registry, so @@ -56,7 +70,8 @@ cl-asdf (2:3.1.2-1) unstable; urgency=low * Substantially rewritten, updated, and expanded manual. * TODO updated. - -- Robert P Goldman <rpgoldman@sift.info> Tue, 6 May 2014 10:54:29 -0500 + -- Francois-Rene Rideau <fare@tunes.org> Mon, 19 May 2014 20:07:40 -0400 + cl-asdf (2:3.0.3-1) unstable; urgency=low diff --git a/debian/copyright b/debian/copyright index 50d501119c9e26a6f97b3d19a33961aca111deda..b7ed5c60dd1eec51d97418a45d4205d331e5b679 100644 --- a/debian/copyright +++ b/debian/copyright @@ -7,7 +7,8 @@ maintained the debian package as part of the upstream git repository at The debian related changes and files are licensed according to the GPL-v2, see /usr/share/common-licenses/GPL-2 -Upstream Authors: Dan Barlow <dan@telent.net> & Contributors +Upstream Authors: Dan Barlow <dan@telent.net>, Francois-Rene Rideau +(fare@tunes.org), Robert P. Goldman (rpgoldman@sift.net) & Contributors. Copyright: @@ -15,7 +16,8 @@ Copyright: http://www.opensource.org/licenses/mit-license.html on or about Monday; July 13, 2009) -Copyright (c) 2001-2014 Daniel Barlow and contributors +Copyright (c) 2001-2014 Daniel Barlow, Francois-Rene Rideau, Robert P. Goldman, +and contributors Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index 6225601ad8d870f4c6388bba556533ed27782f2f..77b98bfbf800fee9f53ab0b71284f6ec265bd8f9 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -903,6 +903,7 @@ For that you may use the following function: regarding source-registry or output-translations. @end defun +@vindex *image-dump-hook* This function is pushed onto the @code{uiop:*image-dump-hook*} by default, which means that if you save an image using @code{uiop:dump-image}, or via @code{asdf:image-op} and @code{asdf:program-op}, @@ -2382,25 +2383,150 @@ the file's @code{last-modified} time exceeds the @code{last-modified} time of the system in memory @end itemize +@cindex ASDF-USER package When system definitions are loaded from @file{.asd} files, -a new scratch package is created for them to load into, -so that different systems do not overwrite each others operations. -The user may also wish to (and is recommended to) -include @code{defpackage} and @code{in-package} forms -in his system definition files, however, -so that they can be loaded manually if need be. +they are implicitly loaded into the @code{ASDF-USER} package, +which uses @code{ASDF}, @code{UIOP} and @code{UIOP/COMMON-LISP}@footnote{ +Note that between releases 2.27 and 3.0.3, only @code{UIOP/PACKAGE}, +not all of @code{UIOP}, was used; if you want your code to work +with releases earlier than 3.1.2, you may have to explicitly define a package +that uses @code{UIOP}, or use proper package prefix to your symbols, as in +@code{uiop:version<}.} +Programmers who do anything non-trivial in a @file{.asd} file, +such as defining new variables, functions or classes, +should include @code{defpackage} and @code{in-package} forms in this file, +so they will not overwrite each others' extensions. +Such forms might also help the files behave identically +if loaded manually with @code{cl:load} for development or debugging, +though we recommend you use the function @code{asdf::load-asd} instead, +which the @code{slime-asdf} contrib knows about. The default value of @code{*system-definition-search-functions*} -is a list of two functions. +is a list of three functions. The first function looks in each of the directories given by evaluating members of @code{*central-registry*} -for a file whose name is the name of the system and whose type is @file{asd}. -The first such file is returned, +for a file whose name is the name of the system and whose type is @file{asd}; +the first such file is returned, whether or not it turns out to actually define the appropriate system. The second function does something similar, -for the directories specified in the @code{source-registry}. -Hence, it is strongly advised to define a system -@var{foo} in the corresponding file @var{foo.asd}. +for the directories specified in the @code{source-registry}, +but searches the filesystem only once and caches its results. +The third function makes the @code{package-inferred-system} extension work, +@pxref{The package-inferred-system extension}. + +Because of the way these search functions are defined, +you should put the definition for a system +@var{foo} in a file named @file{foo.asd}, +in a directory that is +in the central registry or +which can be found using the +source registry configuration. + +@c FIXME: Move this discussion to the system definition grammar, or somewhere else. +@anchor{System names} +@cindex System names +@cindex Primary system name +@findex primary-system-name +It is often useful to define multiple systems in a same file, +but ASDF can only locate a system's definition file based on the system +name. +For this reason, +ASDF 3's system search algorithm has been extended to +allow a file @file{foo.asd} to contain +secondary systems named @var{foo/bar}, @var{foo/baz}, @var{foo/quux}, etc., +in addition to the primary system named @var{foo}. +The first component of a system name, +separated by the slash character, @code{/}, +is called the primary name of a system. +The primary name may be +extracted by function @code{asdf::primary-system-name}; +when ASDF 3 is told to find a system whose name has a slash, +it will first attempt to load the corresponding primary system, +and will thus see any such definitions, and/or any +definition of a @code{package-inferred-system}.@footnote{ +ASDF 2.26 and earlier versions +do not support this primary system name convention. +With these versions of ASDF +you must explicitly load @file{foo.asd} +before you can use system @var{foo/bar} defined therein, +e.g. using @code{(asdf:find-system "foo")}. +We do not support ASDF 2, and recommend that you should upgrade to ASDF 3. +} +If your file @file{foo.asd} also defines systems +that do not follow this convention, e.g., a system named @var{foo-test}, +ASDF will not be able to automatically locate a definition for these systems, +and will only see their definition +if you explicitly find or load the primary system +using e.g. @code{(asdf:find-system "foo")} before you try to use them. +We strongly recommend against this practice, +though it is currently supported for backward compatibility. + +@end defun + +@defun primary-system-name name + +Internal (not exported) function, @code{asdf::primary-system-name}. +Returns the primary system name (the portion before +the slash, @code{/}, in a secondary system name) from @var{name}. + +@end defun + +@defun locate-system name + +This function should typically @emph{not} be invoked directly. It is +exported as part of the API only for programmers who wish to provide +their own @code{*system-definition-search-functions*}. + +Given a system @var{name} designator, +try to locate where to load the system definition from. +@c (This does not include the loading of the system definition, +@c which is done by @code{find-system}, +@c or the loading of the system itself, which is done by @code{load-system}; +@c however, for systems the definition of which has already been loaded, +@c @code{locate-system} may return an object of class @code{system}.) +Returns five values: @var{foundp}, @var{found-system}, @var{pathname}, +@var{previous}, and @var{previous-time}. +@var{foundp} is true when a system was found, +either a new as yet unregistered one, or a previously registered one. +The @var{found-system} return value +will be a @code{system} object, if a system definition is found in your +source registry. +@c This system may be registered (by @code{register-system}) or may not, if +@c it's preloaded code. Fare writes: +@c In the case of preloaded code, as for "asdf", "uiop", etc., +@c themselves, the system objects are not registered until after they are +@c initially located by sysdef-preloaded-system-search as a fallback when +@c no source code was found. +The system definition will @emph{not} be +loaded if it hasn't been loaded already. +@var{pathname} when not null is a path from which to load the system, +either associated with @var{found-system}, or with the @var{previous} system. +If @var{previous} is not null, it will be a @emph{previously loaded} +@code{system} object of the same name (note that the system +@emph{definition} is previously-loaded: the system itself may or may not be). +@var{previous-time} when not null is +the timestamp of the previous system definition file, at the +time when the @var{previous} system definition was loaded. + +For example, if your current registry has @file{foo.asd} in +@file{/current/path/to/foo.asd}, +but system @code{foo} was previously loaded from @file{/previous/path/to/foo.asd} +then @var{locate-system} will return the following values: +@enumerate +@item +@var{foundp} will be @code{T}, +@item +@var{found-system} will be @code{NIL}, +@item +@var{pathname} will be @code{#p"/current/path/to/foo.asd"}, +@item +@var{previous} will be an object of type @code{SYSTEM} with +@code{system-source-file} slot value of +@code{#p"/previous/path/to/foo.asd"} +@item +@var{previous-time} will be the timestamp of +@code{#p"/previous/path/to/foo.asd"} at the time it was loaded. +@end enumerate @end defun @defun find-component base path @@ -2719,8 +2845,8 @@ the default @code{defsystem} macro takes a @code{:class} keyword argument. New component types are defined by subclassing one of the existing component classes and specializing methods on the new component class. -@emph{FIXME: this should perhaps be explained more throughly, -not only by example ...} +@c FIXME: this should perhaps be explained more throughly, +@c not only by example ... As an example, suppose we have some implementation-dependent functionality that we want to isolate @@ -2763,10 +2889,10 @@ The new component type is used in a @code{defsystem} form in this way: @c FIXME: Moved this material here, but it isn't very comfortable @c here.... Also needs to be revised to be coherent. -To be successfully buildable, this graph of actions but be acyclic. -If, as a user, extender or implementer of ASDF, you fail -to keep the dependency graph without cycles, -ASDF will fail loudly as it eventually finds one. +To be successfully build-able, this graph of actions must be acyclic. +If, as a user, extender or implementer of ASDF, you introduce +a cycle into the dependency graph, +ASDF will fail loudly. To clearly distinguish the direction of dependencies, ASDF 3 uses the words @emph{requiring} and @emph{required} as applied to an action depending on the other: @@ -2957,7 +3083,7 @@ however we recommend you instead use our source-registry configuration mechanism described below, because it is easier to setup in a portable way across users and implementations. -Addtionally, some people dislike truename, +Additionally, some people dislike truename, either because it is very slow on their system, or because they are using content-addressed storage where the truename of a file is related to a digest of its individual contents, @@ -3245,9 +3371,9 @@ directory according to X's (relative) instructions. When considering environment variable @code{CL_SOURCE_REGISTRY} ASDF will skip to next configuration if it's an empty string. It will @code{READ} the string as a SEXP in the DSL -if it begins with a paren @code{(} -and it will be interpreted much like @code{TEXINPUTS} -list of paths, where +if it begins with a paren @code{(}, +otherwise it will be interpreted much like @code{TEXINPUTS}, +as a list of paths, where * paths are separated by a @code{:} (colon) on Unix platforms (including cygwin), @@ -3703,7 +3829,7 @@ TRANSLATION-FUNCTION := SYMBOL | ;; symbol naming a function that takes two arguments: ;; the pathname to be translated and the matching ;; DIRECTORY-DESIGNATOR - LAMBDA ;; A form which evalutates to a function taking two arguments: + LAMBDA ;; A form which evaluates to a function taking two arguments: ;; the pathname to be translated and the matching ;; DIRECTORY-DESIGNATOR @@ -3764,7 +3890,7 @@ from the file specified. If the @code{translate-pathname} mechanism cannot achieve a desired translation, the user may provide a function which provides the -required algorithim. Such a translation function is specified by +required algorithm. Such a translation function is specified by supplying a list as the second @code{directory-designator} the first element of which is the keyword @code{:function}, and the second element of which is @@ -5607,3 +5733,6 @@ Also, bugs are now tracked on launchpad: @printindex vr @bye + +@c LocalWords: clbuild tarballs defsystem Quicklisp initarg uiop fasl +@c LocalWords: namestring initargs fasls diff --git a/doc/index.html b/doc/index.html index 303f8d7cee37f73532137270cbccd2305788eb8d..d0cb252f5803817c856abfbb70543bdab773aca4 100644 --- a/doc/index.html +++ b/doc/index.html @@ -39,7 +39,7 @@ and the ability to deliver standalone executables. It was pre-released as 2.27 on February 1st 2013, released as 3.0.0 on May 15th 2013, - and again as 3.1.2 on May 6th 2014. + again as 3.1.2 on May 6th 2014, and as 3.1.3 on 24 July 2014. </p> <a id="what_it_is"></a> <h3>What it is</h3> @@ -419,6 +419,11 @@ XCL (Peter Graves) <gnooth@gmail.com> <a id="news"></a> <h3>What is happening</h3> <dl> + <dt>May 2014 to July 2014</dt> + <dd>ASDF bug fixing from 3.1.2 leads to release of 3.1.3, a major bug + fix release. We strongly urge implementors that have shipped with 3.1.2 + to upgrade to 3.1.3. There should be no incompatibilities, and some + very important bug fixes are provided. See the Changelog for more details.</dd> <dt>July 2013 to May 2014</dt> <dd>François-René Rideau has resigned as maintainer but remained an active developer. diff --git a/find-component.lisp b/find-component.lisp index 4395648b8492af087aa4d9b14badb8708868fc94..19360783496a9d7f5cfbf16bd9abba444a32f293 100644 --- a/find-component.lisp +++ b/find-component.lisp @@ -107,10 +107,10 @@ (and (typep c 'missing-dependency) (eq (missing-required-by c) component) (equal (missing-requires c) name)))) - (unless (component-parent component) - (let ((name (coerce-name name))) - (unset-asdf-cache-entry `(find-system ,name)) - (unset-asdf-cache-entry `(locate-system ,name)))))))) + (unless (component-parent component) + (let ((name (coerce-name name))) + (unset-asdf-cache-entry `(find-system ,name)) + (unset-asdf-cache-entry `(locate-system ,name)))))))) (defun resolve-dependency-spec (component dep-spec) diff --git a/find-system.lisp b/find-system.lisp index fde016c3dc59793d97ab4b57cc639eb68b40b768..3ecc03b46ce35a5acccb53788bb010a07114bc9c 100644 --- a/find-system.lisp +++ b/find-system.lisp @@ -99,8 +99,8 @@ of which is a system object.") (defun clear-defined-systems () ;; Invalidate all systems but ASDF itself, if registered. (loop :for name :being :the :hash-keys :of *defined-systems* - :unless (equal name "asdf") - :do (clear-defined-system name))) + :unless (equal name "asdf") + :do (clear-defined-system name))) (register-hook-function '*post-upgrade-cleanup-hook* 'clear-defined-systems nil) @@ -353,79 +353,70 @@ but not loaded in memory" Returns five values: FOUNDP FOUND-SYSTEM PATHNAME PREVIOUS PREVIOUS-TIME 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 as is -PATHNAME when not null is a path from where to load the system, +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." - (with-asdf-cache (:key `(locate-system ,name)) - (let* ((name (coerce-name name)) - (in-memory (system-registered-p name)) ; load from disk if absent or newer on disk - (previous (cdr in-memory)) - (previous (and (typep previous 'system) previous)) - (previous-time (car in-memory)) - (found (search-for-system-definition name)) - (found-system (and (typep found 'system) found)) - (pathname (ensure-pathname - (or (and (typep found '(or pathname string)) (pathname found)) - (and found-system (system-source-file found-system)) - (and previous (system-source-file previous))) - :want-absolute t :resolve-symlinks *resolve-symlinks*)) - (foundp (and (or found-system pathname previous) t))) - (check-type found (or null pathname system)) - (unless (check-not-old-asdf-system name pathname) - (cond - (previous (setf found nil pathname nil)) - (t - (setf found (sysdef-preloaded-system-search "asdf")) - (assert (typep found 'system)) - (setf found-system found pathname nil)))) - (values foundp found-system pathname previous previous-time)))) + (let* ((name (coerce-name name)) + (in-memory (system-registered-p name)) ; load from disk if absent or newer on disk + (previous (cdr in-memory)) + (previous (and (typep previous 'system) previous)) + (previous-time (car in-memory)) + (found (search-for-system-definition name)) + (found-system (and (typep found 'system) found)) + (pathname (ensure-pathname + (or (and (typep found '(or pathname string)) (pathname found)) + (and found-system (system-source-file found-system)) + (and previous (system-source-file previous))) + :want-absolute t :resolve-symlinks *resolve-symlinks*)) + (foundp (and (or found-system pathname previous) t))) + (check-type found (or null pathname system)) + (unless (check-not-old-asdf-system name pathname) + (cond + (previous (setf found nil pathname nil)) + (t + (setf found (sysdef-preloaded-system-search "asdf")) + (assert (typep found 'system)) + (setf found-system found pathname nil)))) + (values foundp found-system pathname previous previous-time))) (defmethod find-system ((name string) &optional (error-p t)) (with-asdf-cache (:key `(find-system ,name)) (let ((primary-name (primary-system-name name))) (unless (equal name primary-name) (find-system primary-name nil))) - (loop - (restart-case - (multiple-value-bind (foundp found-system pathname previous previous-time) - (locate-system name) - (when (and found-system (eq found-system previous) - (or (first (gethash `(find-system ,name) *asdf-cache*)) - (and *immutable-systems* (gethash name *immutable-systems*)))) - (return found-system)) - (assert (eq foundp (and (or found-system pathname previous) t))) - (let ((previous-pathname (and previous (system-source-file previous))) - (system (or previous found-system))) - (when (and found-system (not previous)) - (register-system found-system)) - (when (and system pathname) - (setf (system-source-file system) pathname)) - (when (and pathname - (let ((stamp (get-file-stamp pathname))) - (and stamp - (not (and previous - (or (pathname-equal pathname previous-pathname) - (and pathname previous-pathname - (pathname-equal - (physicalize-pathname pathname) - (physicalize-pathname previous-pathname)))) - (stamp<= stamp previous-time)))))) - ;; only load when it's a pathname that is different or has newer content, and not an old asdf - (load-asd pathname :name name))) - (let ((in-memory (system-registered-p name))) ; try again after loading from disk if needed - (return - (cond - (in-memory - (when pathname - (setf (car in-memory) (get-file-stamp pathname))) - (cdr in-memory)) - (error-p - (error 'missing-component :requires name)))))) - (reinitialize-source-registry-and-retry () - :report (lambda (s) - (format s (compatfmt "~@<Retry finding system ~A after reinitializing the source-registry.~@:>") name)) - (unset-asdf-cache-entry `(locate-system ,name)) - (initialize-source-registry))))))) - + (or (and *immutable-systems* (gethash name *immutable-systems*) + (cdr (system-registered-p name))) + (multiple-value-bind (foundp found-system pathname previous previous-time) + (locate-system name) + (assert (eq foundp (and (or found-system pathname previous) t))) + (let ((previous-pathname (and previous (system-source-file previous))) + (system (or previous found-system))) + (when (and found-system (not previous)) + (register-system found-system)) + (when (and system pathname) + (setf (system-source-file system) pathname)) + (when (and pathname + (let ((stamp (get-file-stamp pathname))) + (and stamp + (not (and previous + (or (pathname-equal pathname previous-pathname) + (and pathname previous-pathname + (pathname-equal + (physicalize-pathname pathname) + (physicalize-pathname previous-pathname)))) + (stamp<= stamp previous-time)))))) + ;; only load when it's a pathname that is different or has newer content, and not an old asdf + (load-asd pathname :name name))) + (let ((in-memory (system-registered-p name))) ; try again after loading from disk if needed + (cond + (in-memory + (when pathname + (setf (car in-memory) (get-file-stamp pathname))) + (cdr in-memory)) + (error-p + (error 'missing-component :requires name)) + (t ;; not found: don't keep negative cache, see lp#1335323 + (unset-asdf-cache-entry `(locate-system ,name)) + (return-from find-system nil))))))))) diff --git a/header.lisp b/header.lisp index 5bf8851951e28255db6a9996089b4702cf2773b3..5c2219699f3b4cfdda84cc82f12cfeedd14b0cde 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*- -;;; This is ASDF 3.1.2.4: Another System Definition Facility. +;;; This is ASDF 3.1.3: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. diff --git a/interface.lisp b/interface.lisp index ea703c1e969d58748c2620a966b707e482bdb8d0..f637b3a818a84dbd47d1e36c44ac44c014d372d0 100644 --- a/interface.lisp +++ b/interface.lisp @@ -126,11 +126,13 @@ #:package-inferred-system-missing-package-error #:operation-definition-warning #:operation-definition-error - #:try-recompiling + #:try-recompiling ; restarts #:retry - #:accept ; restarts + #:accept #:coerce-entry-to-directory #:remove-entry-from-registry + #:clear-configuration-and-retry + #:*encoding-detection-hook* #:*encoding-external-format-hook* @@ -166,5 +168,6 @@ #:user-source-registry #:system-source-registry #:user-source-registry-directory - #:system-source-registry-directory)) + #:system-source-registry-directory + )) diff --git a/operate.lisp b/operate.lisp index 9562165a41591af4eb698faa269dd0547e79d43b..370a4eebbdf6b11e344b2ba518d48a1db2998eea 100644 --- a/operate.lisp +++ b/operate.lisp @@ -111,7 +111,8 @@ The default operation may change in the future if we implement a component-directed strategy for how to load or compile systems.") (defmethod component-depends-on ((o prepare-op) (s system)) - `((,*load-system-operation* ,@(component-sideway-dependencies s)))) + (loop :for (o . cs) :in (call-next-method) + :collect (cons (if (eq o 'load-op) *load-system-operation* o) cs))) (defclass build-op (non-propagating-operation) () (:documentation "Since ASDF3, BUILD-OP is the recommended 'master' operation, @@ -122,7 +123,8 @@ as a symbol or as a string later read as a symbol (after loading the defsystem-d if NIL is specified (the default), BUILD-OP falls back to the *LOAD-SYSTEM-OPERATION* that will load the system in the current image, and its typically LOAD-OP.")) (defmethod component-depends-on ((o build-op) (c component)) - `((,(or (component-build-operation c) *load-system-operation*) ,c))) + `((,(or (component-build-operation c) *load-system-operation*) ,c) + ,@(call-next-method))) (defun make (system &rest keys) "The recommended way to interact with ASDF3.1 is via (ASDF:MAKE :FOO). diff --git a/test/dll-test.lisp b/test/dll-test.lisp index 590bfef332dd21e82f6dc4816072aba4e9281f37..ab2a3e363f7734718117f6681035053b2d29aacc 100644 --- a/test/dll-test.lisp +++ b/test/dll-test.lisp @@ -6,7 +6,7 @@ extern int sample_function(); int sample_function() { - return 42; + return 42; } ") @@ -16,6 +16,6 @@ extern MKCL_DLLEXPORT int sample_function(void); int sample_function(void) { - return 42; + return 42; } ") diff --git a/test/monodll-1.lisp b/test/monodll-1.lisp index c49d48172840d944734a57344712a15a1542466f..6251610dadf3262364d880abae274aff229728af 100644 --- a/test/monodll-1.lisp +++ b/test/monodll-1.lisp @@ -6,7 +6,7 @@ extern int always_7(); int always_7() { - return 7; + return 7; } ") @@ -16,6 +16,6 @@ extern MKCL_DLLEXPORT int always_7(void); int always_7(void) { - return 7; + return 7; } ") diff --git a/test/monodll.lisp b/test/monodll.lisp index 0859b6757969c4b73629f7a870565c68adec47f0..8e00be0cda1dee95cbb593e172ca59e11a42606c 100644 --- a/test/monodll.lisp +++ b/test/monodll.lisp @@ -6,7 +6,7 @@ extern int always_42(); int always_42() { - return 6*always_7(); + return 6*always_7(); } ") @@ -16,6 +16,6 @@ extern MKCL_DLLEXPORT int always_42(void); int always_42(void) { - return 6*always_7(); + return 6*always_7(); } ") diff --git a/test/script-support.lisp b/test/script-support.lisp index ee90ba76eab3af9e0898ed99aa323cceb7f42ac5..d4c83b3afa4e0b388e5eb83fda3ac7e246bbd741 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -552,16 +552,18 @@ is bound, write a message and exit on an error. If (when (asym :*verbose-out*) (setf (asymval :*verbose-out*) *standard-output*)) (when (and (asym :locate-system) (asym :pathname-directory-pathname) (asym :pathname-equal)) (format t "Comparing directories~%") - (let ((x (acall :pathname-directory-pathname (nth-value 2 (acall :locate-system :test-asdf))))) - (assert-pathname-equal-helper ;; not always EQUAL (!) - '*test-directory* *test-directory* - '(:pathname-directory-pathname (nth-value 2 (:locate-system :test-asdf))) x) - (unless (equal *test-directory* x) - (format t "Interestingly, while *test-directory* has components~% ~S~%~ + (acall :call-with-asdf-cache + #'(lambda () + (let ((x (acall :pathname-directory-pathname (nth-value 2 (acall :locate-system :test-asdf))))) + (assert-pathname-equal-helper ;; not always EQUAL (!) + '*test-directory* *test-directory* + '(:pathname-directory-pathname (nth-value 2 (:locate-system :test-asdf))) x) + (unless (equal *test-directory* x) + (format t "Interestingly, while *test-directory* has components~% ~S~%~ ASDF finds the ASDs in~% ~S~%Using the latter.~%" - (pathname-components *test-directory*) - (pathname-components x))) - (setf *test-directory* x))) + (pathname-components *test-directory*) + (pathname-components x))) + (setf *test-directory* x))))) t) (defun frob-packages () diff --git a/test/test-cache.script b/test/test-cache.script new file mode 100644 index 0000000000000000000000000000000000000000..81e8ff7278ac9c7f1ac304b3e2afc5bae17acd54 --- /dev/null +++ b/test/test-cache.script @@ -0,0 +1,35 @@ +;;; -*- Lisp -*- + +;;; test to check that the cache doesn't upset error signaling from FIND-SYSTEM + + +(in-package asdf-test) + +(defparameter *all-systems* + (list + "test-asdf" + "test-asdf/all" + "test-asdf/1" + "test-asdf/2" + "test-asdf/4" + "test-asdf/test9-1" + "test-asdf/test-module-depend" + "test-asdf/test9-2" + "test-asdf/test9-3" + "test-asdf/test-source-directory-1" + "test-asdf/test-source-directory-2" + "test-asdf/bundle-1" + "test-asdf/bundle-2" + "test-asdf/force" + "test-asdf/force1")) + +(defun clear-caches-and-search () + (setf asdf:*central-registry* nil) + (mapc #'asdf/find-system:clear-defined-system *all-systems*)) + +(clear-caches-and-search) +(assert (not (asdf:find-system "test-asdf/force1" nil))) +(multiple-value-bind (ret cond) + (ignore-errors (asdf:find-system "test-asdf/force1" t)) + (assert (not ret)) + (assert (typep cond 'asdf:missing-component))) diff --git a/test/test-try-refinding.script b/test/test-try-refinding.script new file mode 100644 index 0000000000000000000000000000000000000000..ec1da8d30ff42e642c4a73294970edab4572deea --- /dev/null +++ b/test/test-try-refinding.script @@ -0,0 +1,83 @@ +;;; -*- Lisp -*- + +;;; test retrying finding location of an ASDF system. + + +(in-package asdf-test) +(defparameter *old-registry* asdf:*central-registry*) +;;(defparameter *search-table* (hash-table->alist asdf::*source-registry*)) +;;(pprint *search-table*) +;;(terpri) +(assert (asdf:find-system "test-asdf/force1")) + +(defun clear-caches-and-search () + (setf asdf:*central-registry* nil) + (asdf/find-system:clear-defined-system "test-asdf") + (asdf/find-system:clear-defined-system "test-asdf/force1")) + +(DBG "Clearing the caches and finding.") +(clear-caches-and-search) +(assert (not (asdf:find-system "test-asdf/force1" nil))) +(DBG "Correctly failed to find system.") +(assert + (let (tried-once) + (with-asdf-cache (:override t) + (handler-bind + ((asdf:missing-component + #'(lambda (c) + (DBG "Caught MISSING-COMPONENT condition.") + (if (not tried-once) + (let ((missing (asdf::missing-requires c))) + (assert (equal missing "test-asdf/force1")) + (setf tried-once t) + (setf asdf:*central-registry* *old-registry*) + (invoke-restart 'asdf:retry)) + ;; avoid infinite looping + (error c))))) + (asdf:find-system "test-asdf/force1" t))))) + +(DBG "Refinding test successful.") + +(DBG "Now trying LOAD-SYSTEM with refinding.") +(clear-caches-and-search) + +(def-test-system test-missing-dependency + :depends-on ("test-asdf/force1") + :components ((:file "file2"))) +;; (trace find-system) +;; (trace find-component) +;; (trace asdf::component-find-path) +;; (trace operate) +(let (tried-once) + (with-asdf-cache (:override t) + (flet ((handle-missing (c) + (if (not tried-once) + (let ((missing (asdf::missing-requires c))) + (assert (equal missing "test-asdf/force1")) + (setf tried-once t) + (DBG "Trying to reset the central registry and retry.") + (setf asdf:*central-registry* *old-registry*) + (unless (find-restart 'asdf:clear-configuration-and-retry) + (error "Expected CLEAR-CONFIGURATION-AND-RETRY restart not found.")) + (DBG "Before invoking restart, CENTRAL-REGISTRY is:" + asdf:*central-registry*) + (invoke-restart 'asdf:clear-configuration-and-retry) + (DBG "After invoking restart, CENTRAL-REGISTRY is:" + asdf:*central-registry*)) + ;; avoid infinite looping + (error c)))) + (handler-bind + ((asdf:missing-dependency-of-version + #'(lambda (c) + ;; Nothing Quicklisp can do to recover from this, so + ;; just resignal + (error c))) + (asdf:missing-dependency + #'(lambda (c) + (DBG "Catching MISSING-DEPENDENCY condition:" tried-once) + (handle-missing c))) + (asdf:missing-component + #'(lambda (c) + (DBG "Catching MISSING-COMPONENT condition:" tried-once) + (handle-missing c)))) + (asdf:load-system "test-missing-dependency"))))) diff --git a/test/test-utilities.script b/test/test-utilities.script index 9e2217e4d728b1ab15e7ea10bc103fa99988dd9e..ec02a68fd54411ff6690d82cbb8bc89ca65bf3cd 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -160,6 +160,8 @@ asdf/backward-interface:on-warnings asdf/find-system:contrib-sysdef-search asdf/find-system:sysdef-find-asdf + ;; restart + asdf/cache:clear-configuration-and-retry )) (defun defined-symbol-p (symbol) diff --git a/uiop/configuration.lisp b/uiop/configuration.lisp index 5e1b87886f1a553314fa86b13ade9d86df30ec4b..07e90e626a1c97d14f0ed33bd66ced92c19bce21 100644 --- a/uiop/configuration.lisp +++ b/uiop/configuration.lisp @@ -148,7 +148,7 @@ this function tries to locate the Windows FOLDER for one of "Map the VALIDATOR across the .conf files in DIRECTORY, the TAG will be applied to the results to yield a configuration form. Current values of TAG include :source-registry and :output-translations." - (let ((files (sort (ignore-errors + (let ((files (sort (ignore-errors ;; SORT w/o COPY-LIST is OK: DIRECTORY returns a fresh list (remove-if 'hidden-pathname-p (directory* (make-pathname :name *wild* :type "conf" :defaults directory)))) diff --git a/uiop/image.lisp b/uiop/image.lisp index ca8a1ffb1cf56bd92d0590c9a854565e9d319c19..6cbfd613816ef5d5a2e87a1dd623ec68e5ea1d0b 100644 --- a/uiop/image.lisp +++ b/uiop/image.lisp @@ -95,8 +95,8 @@ This is designed to abstract away the implementation specific quit forms." (declare (ignorable stream count condition)) #+abcl (loop :for i :from 0 - :for frame :in (sys:backtrace (or count most-positive-fixnum)) :do - (safe-format! stream "~&~D: ~A~%" i frame)) + :for frame :in (sys:backtrace (or count most-positive-fixnum)) :do + (safe-format! stream "~&~D: ~A~%" i frame)) #+allegro (let ((*terminal-io* stream) (*standard-output* stream) @@ -120,20 +120,20 @@ This is designed to abstract away the implementation specific quit forms." (debug:backtrace (or count most-positive-fixnum) stream)) #+(or ecl mkcl) (let* ((top (si:ihs-top)) - (repeats (if count (min top count) top)) - (backtrace (loop :for ihs :from 0 :below top + (repeats (if count (min top count) top)) + (backtrace (loop :for ihs :from 0 :below top :collect (list (si::ihs-fun ihs) (si::ihs-env ihs))))) (loop :for i :from 0 :below repeats - :for frame :in (nreverse backtrace) :do - (safe-format! stream "~&~D: ~S~%" i frame))) + :for frame :in (nreverse backtrace) :do + (safe-format! stream "~&~D: ~S~%" i frame))) #+gcl (let ((*debug-io* stream)) (ignore-errors (with-safe-io-syntax () - (if condition - (conditions::condition-backtrace condition) - (system::simple-backtrace))))) + (if condition + (conditions::condition-backtrace condition) + (system::simple-backtrace))))) #+lispworks (let ((dbg::*debugger-stack* (dbg::grab-stack nil :how-many (or count most-positive-fixnum))) @@ -147,8 +147,8 @@ This is designed to abstract away the implementation specific quit forms." stream) #+xcl (loop :for i :from 0 :below (or count most-positive-fixnum) - :for frame :in (extensions:backtrace-as-list) :do - (safe-format! stream "~&~D: ~S~%" i frame))) + :for frame :in (extensions:backtrace-as-list) :do + (safe-format! stream "~&~D: ~S~%" i frame))) (defun print-backtrace (&rest keys &key stream count condition) "Print a backtrace" @@ -248,14 +248,14 @@ if we are not called from a directly executable image." ;; SBCL and Allegro already separate user arguments from implementation arguments. #-(or sbcl allegro) (unless (eq *image-dumped-p* :executable) - ;; LispWorks command-line processing isn't transparent to the user - ;; unless you create a standalone executable; in that case, - ;; we rely on cl-launch or some other script to set the arguments for us. - #+lispworks (return *command-line-arguments*) - ;; On other implementations, on non-standalone executables, - ;; we trust cl-launch or whichever script starts the program - ;; to use -- as a delimiter between implementation arguments and user arguments. - #-lispworks (setf arguments (member "--" arguments :test 'string-equal))) + ;; LispWorks command-line processing isn't transparent to the user + ;; unless you create a standalone executable; in that case, + ;; we rely on cl-launch or some other script to set the arguments for us. + #+lispworks (return *command-line-arguments*) + ;; On other implementations, on non-standalone executables, + ;; we trust cl-launch or whichever script starts the program + ;; to use -- as a delimiter between implementation arguments and user arguments. + #-lispworks (setf arguments (member "--" arguments :test 'string-equal))) (rest arguments))) (defun argv0 () @@ -290,7 +290,7 @@ immediately to the surrounding restore process if allowed to continue. Then, comes the restore process itself: First, call each function in the RESTORE-HOOK, -in the order they were registered with REGISTER-RESTORE-HOOK. +in the order they were registered with REGISTER-IMAGE-RESTORE-HOOK. Second, evaluate the prelude, which is often Lisp text that is read, as per EVAL-INPUT. Third, call the ENTRY-POINT function, if any is specified, with no argument. @@ -335,7 +335,7 @@ of the function will be returned rather than interpreted as a boolean designatin (dump-hook *image-dump-hook*) #+clozure prepend-symbols #+clozure (purify t) #+sbcl compression - #+(and sbcl windows) application-type) + #+(and sbcl os-windows) application-type) "Dump an image of the current Lisp environment at pathname FILENAME, with various options. First, finalize the image, by evaluating the POSTLUDE as per EVAL-INPUT, then calling each of @@ -409,7 +409,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows." (when compression (list :compression compression)) ;;--- only save runtime-options for standalone executables (when executable (list :toplevel #'restore-image :save-runtime-options t)) - #+(and sbcl windows) ;; passing :application-type :gui will disable the console window. + #+(and sbcl os-windows) ;; passing :application-type :gui will disable the console window. ;; the default is :console - only works with SBCL 1.1.15 or later. (when application-type (list :application-type application-type))))) #-(or allegro clisp clozure cmu gcl lispworks sbcl scl) diff --git a/uiop/os.lisp b/uiop/os.lisp index 2a714b22658abf8c2083d567e90aaa0d0833171e..522f4a388e3684ed2b8be4a45ae2713db45854b2 100644 --- a/uiop/os.lisp +++ b/uiop/os.lisp @@ -146,10 +146,13 @@ then returning the non-empty string value of the variable" (defun operating-system () "The operating system of the current host" (first-feature - '(:cygwin (:win :windows :mswindows :win32 :mingw32) ;; try cygwin first! + '(:cygwin + (:win :windows :mswindows :win32 :mingw32) ;; try cygwin first! (:linux :linux :linux-target) ;; for GCL at least, must appear before :bsd (:macosx :macosx :darwin :darwin-target :apple) ; also before :bsd - (:solaris :solaris :sunos) (:bsd :bsd :freebsd :netbsd :openbsd) :unix + (:solaris :solaris :sunos) + (:bsd :bsd :freebsd :netbsd :openbsd :dragonfly) + :unix :genera))) (defun architecture () diff --git a/uiop/package.lisp b/uiop/package.lisp index 77ff4101a614179b8a8f0119d55da863e4ac1e78..1d928a326571241a03d536ac5877333107b0f3a0 100644 --- a/uiop/package.lisp +++ b/uiop/package.lisp @@ -317,7 +317,7 @@ or when loading the package is optional." (imported) (t (push name intern))))))) (labels ((sort-names (names) - (sort names #'string<)) + (sort (copy-list names) #'string<)) (table-keys (table) (loop :for k :being :the :hash-keys :of table :collect k)) (when-relevant (key value) diff --git a/uiop/pathname.lisp b/uiop/pathname.lisp index 8bb82ac8a99441708d0eebeb4d4f8d6120eab920..7d89b755f295cd874bfeb8449a0a8bd9f2aebe55 100644 --- a/uiop/pathname.lisp +++ b/uiop/pathname.lisp @@ -580,7 +580,7 @@ when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPA "if MAYBE-SUBPATH is a pathname that is under BASE-PATHNAME, return a pathname object that when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPATH." (let ((sub (when maybe-subpath (pathname maybe-subpath))) - (base (when base-pathname (ensure-absolute-pathname (pathname base-pathname))))) + (base (when base-pathname (ensure-absolute-pathname (pathname base-pathname))))) (or (and base (subpathp sub base)) sub))) (defun call-with-enough-pathname (maybe-subpath defaults-pathname thunk) diff --git a/upgrade.lisp b/upgrade.lisp index c83266f4f774ce7b3ee60903135d2b778e0165a9..16bcdddc0c6628fedd2ba46ce929ac48be65f7b5 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -67,7 +67,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.1.2.4") + (asdf-version "3.1.3") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) @@ -79,26 +79,26 @@ previously-loaded version of ASDF." (when-upgrading () (let ((redefined-functions ;; gf signature and/or semantics changed incompatibly. Oops. - ;; NB: it's too late to do anything about functions in UIOP! - ;; If you introduce some critically incompatibility there, you must change name. + ;; NB: it's too late to do anything about functions in UIOP! + ;; If you introduce some critically incompatibility there, you must change name. '(#:component-relative-pathname #:component-parent-pathname ;; component #:source-file-type #:find-system #:system-source-file #:system-relative-pathname ;; system - #:find-component ;; find-component - #:explain #:perform #:perform-with-restarts #:input-files #:output-files ;; action - #:component-depends-on #:operation-done-p #:component-depends-on - #:traverse ;; backward-interface + #:find-component ;; find-component + #:explain #:perform #:perform-with-restarts #:input-files #:output-files ;; action + #:component-depends-on #:operation-done-p #:component-depends-on + #:traverse ;; backward-interface #:map-direct-dependencies #:reduce-direct-dependencies #:direct-dependencies ;; plan - #:operate ;; operate - #:parse-component-form ;; defsystem - #:apply-output-translations ;; output-translations - #:process-output-translations-directive - #:inherit-source-registry #:process-source-registry ;; source-registry - #:process-source-registry-directive - #:trivial-system-p)) ;; bundle - (redefined-classes + #:operate ;; operate + #:parse-component-form ;; defsystem + #:apply-output-translations ;; output-translations + #:process-output-translations-directive + #:inherit-source-registry #:process-source-registry ;; source-registry + #:process-source-registry-directive + #:trivial-system-p)) ;; bundle + (redefined-classes ;; redefining the classes causes interim circularities - ;; with the old ASDF during upgrade, and many implementations bork + ;; with the old ASDF during upgrade, and many implementations bork '((#:compile-concatenated-source-op (#:operation) ())))) (loop :for name :in redefined-functions :for sym = (find-symbol* name :asdf nil) :do @@ -106,12 +106,12 @@ previously-loaded version of ASDF." ;; On CLISP we seem to be unable to fmakunbound and define a function in the same fasl. Sigh. #-clisp (fmakunbound sym))) (labels ((asym (x) (multiple-value-bind (s p) (if (consp x) (values (car x) (cadr x)) (values x :asdf)) - (find-symbol* s p nil))) - (asyms (l) (mapcar #'asym l))) + (find-symbol* s p nil))) + (asyms (l) (mapcar #'asym l))) (loop* :for (name superclasses slots) :in redefined-classes - :for sym = (find-symbol* name :asdf nil) - :when (and sym (find-class sym)) - :do (eval `(defclass ,sym ,(asyms superclasses) ,(asyms slots))))))) + :for sym = (find-symbol* name :asdf nil) + :when (and sym (find-class sym)) + :do (eval `(defclass ,sym ,(asyms superclasses) ,(asyms slots))))))) ;;; Self-upgrade functions diff --git a/version.lisp-expr b/version.lisp-expr index ecf9a58b0b3f0a442805428938692d75b2c6e47c..c20549dc5c2a4cf84feba042232df55802797a90 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1,2 +1,2 @@ -"3.1.2.4" +"3.1.3"