diff --git a/Makefile b/Makefile index 2f290f3f9368d338df6ecf15d8645edf11095e72..c9287d067f23719c7f8f7334d09daa2b6d87b3c9 100644 --- a/Makefile +++ b/Makefile @@ -60,6 +60,7 @@ all_lisp := $(header_lisp) $(driver_lisp) $(defsystem_lisp) # Making ASDF itself should be our first, default, target: build/asdf.lisp: $(all_lisp) mkdir -p build + rm -f $@ cat $(all_lisp) > $@ # This quickly locates such mistakes as unbalanced parentheses: @@ -120,6 +121,7 @@ clean: fi; \ done rm -rf build/ LICENSE test/try-reloading-dependency.asd test/hello-world-example asdf.lisp + rm -rf test/hello-world-example.exe test/mkcl_*.dll # needed only on MS-Windows rm -rf .pc/ build-stamp debian/patches/ debian/debhelper.log debian/cl-asdf/ # debian crap ${MAKE} -C doc clean diff --git a/TODO b/TODO index 174a06a805bd5578b276c583de5307ce93682115..a1e37163c6051ae4d37c74f69051d10740cd4c3d 100644 --- a/TODO +++ b/TODO @@ -128,6 +128,7 @@ but prints the namestring with a dot separator! (make-pathname :name "foo" :type :unspecific) ==> #P"foo." If bug is ever fixed, upgrade *unspecific-pathname-type* in uiop/pathname. +*** XCL doesn't properly process files the name of which contains a * ** GCL is almost working again; but implementation bugs remain. See November 2013 discussion on gcl-devel. @@ -157,6 +158,7 @@ *** `#5(1 ,@`(2 3)))` returns #(1 2 3), rather than #(1 2 3 2 3 2 3 2 3) or even better #(1 2 3 3 3). *** (DIRECTORY #p"*.*") fails to match files with pathname type NIL. +*** GCL doesn't properly process files the name of which contains a * *** Require is useless, because there is no system search path, and so you can't put ASDF (or anything) there. *** Low-level compiler bug: @@ -166,11 +168,13 @@ *** ABCL fails the timestamp propagation test. *** `#5(1 ,@`(2 3)))` returns #(1 2 3), rather than #(1 2 3 2 3 2 3 2 3) or even better #(1 2 3 3 3). +*** ABCL doesn't properly process files the name of which contains a * ** ECL has issues with its bundles. On MacOS X, test-bundle.script fails. On Linux, test-program.script fails with recent ECL 237af2e, but used to work quite fine earlier in 2013. +*** ECL doesn't properly process files the name of which contains a * * Design & Implement some out-of-line configuration mechanism for various options? i.e. let configuration files override some variables around some actions. @@ -185,6 +189,7 @@ *** have a function verify-strict-asd that can verify a asd is pure lp#541562 Then if it passes, use load-strict-asd. If not, optionally issue a warning. Start migrating people toward that. +*** Include tests for prebuilt-system in test-bundle and in test-program. * Learn to use cl-grid-test ** So we can easily make sure ASDF changes don't break stuff, diff --git a/asdf.asd b/asdf.asd index 9bd9977c506a42add66c07511b1a3eccb71d2c4d..02a8ab1f0747eb8399a9cbe962d0d7c54f084a8c 100644 --- a/asdf.asd +++ b/asdf.asd @@ -58,7 +58,7 @@ (:file "source-registry" :depends-on ("find-system")) (:file "backward-internals" :depends-on ("lisp-action" "operate")) (:file "parse-defsystem" :depends-on ("backward-internals" "cache" "system")) - (:file "bundle" :depends-on ("lisp-action" "operate")) + (:file "bundle" :depends-on ("lisp-action" "operate" "parse-defsystem")) (:file "concatenate-source" :depends-on ("plan" "parse-defsystem" "bundle")) (:file "backward-interface" :depends-on ("operate" "output-translations")) (:file "package-system" :depends-on ("system" "find-system" "parse-defsystem")) @@ -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.0.94" ;; to be automatically updated by make bump-version + :version "3.1.0.102" ;; to be automatically updated by make bump-version :depends-on () #+asdf3 :encoding #+asdf3 :utf-8 :class #.(if (find-class 'package-system nil) 'package-system 'system) diff --git a/bin/install-asdf-as-module b/bin/install-asdf-as-module index a04588bf4b1d3bec4c2121c8523e7338d5901e76..64bdfbe2c75c5138dbfe20cce62658d45f78b257 100644 --- a/bin/install-asdf-as-module +++ b/bin/install-asdf-as-module @@ -16,7 +16,12 @@ It notably doesn't work on: * mocl, that doesn't support ASDF 3 yet. * Corman Lisp, RMCL, Genera, that are obsolete anyway. |# -(require :asdf) +(ignore-errors (funcall 'require "asdf")) ;; Load the implementation-provided ASDF +#-asdf2 (load (merge-pathnames ;; Fall back to loading ASDF manually + (make-pathname :name "asdf" :type "lisp" :version nil + :directory '(:relative :back "build") :defaults *load-pathname*) + *load-pathname*)) +(asdf:load-system :asdf) ;; Upgrade to the latest ASDF3 (assumes you have it configured properly) (in-package :asdf) diff --git a/bundle.lisp b/bundle.lisp index fe020bf359837838014378d84047bc9ff1dcee45..f016c9d3bf05ef50956c4aae56df1646af5fd761 100644 --- a/bundle.lisp +++ b/bundle.lisp @@ -5,7 +5,7 @@ (:recycle :asdf/bundle :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation - :asdf/action :asdf/lisp-action :asdf/plan :asdf/operate) + :asdf/action :asdf/lisp-action :asdf/plan :asdf/operate :asdf/defsystem) (:export #:bundle-op #:bundle-op-build-args #:bundle-type #:bundle-system #:bundle-pathname-type #:bundlable-file-p #:direct-dependency-files @@ -26,9 +26,7 @@ ((build-args :initarg :args :initform nil :accessor bundle-op-build-args) (name-suffix :initarg :name-suffix :initform nil) (bundle-type :initform :no-output-file :reader bundle-type) - #+ecl (lisp-files :initform nil :accessor bundle-op-lisp-files) - #+mkcl (do-fasb :initarg :do-fasb :initform t :reader bundle-op-do-fasb-p) - #+mkcl (do-static-library :initarg :do-static-library :initform t :reader bundle-op-do-static-library-p))) + #+ecl (lisp-files :initform nil :accessor bundle-op-lisp-files))) (defclass monolithic-op (operation) () (:documentation "A MONOLITHIC operation operates on a system *and all of its @@ -47,6 +45,19 @@ itself.")) ;; operation on a system and its dependencies ((prologue-code :accessor prologue-code) (epilogue-code :accessor epilogue-code))) + #+mkcl + (defclass program (bundle-system) + ((prologue-code :initarg :prologue-code :initform nil :accessor prologue-code) + (epilogue-code :initarg :epilogue-code :initform nil :accessor epilogue-code) + (prefix-lisp-object-files :initarg :prefix-lisp-object-files + :initform nil :accessor program-prefix-lisp-object-files) + (postfix-lisp-object-files :initarg :postfix-lisp-object-files + :initform nil :accessor program-postfix-lisp-object-files) + (object-files :initarg :object-files + :initform nil :accessor program-object-files) + (extra-build-args :initarg :extra-build-args + :initform nil :accessor program-extra-build-args))) + (defmethod prologue-code ((x t)) nil) (defmethod epilogue-code ((x t)) nil) @@ -77,7 +88,7 @@ itself.")) ;; operation on a system and its dependencies ((bundle-type :initform :fasl))) (defclass prepare-fasl-op (sideway-operation) - ((sideway-operation :initform #+ecl 'load-fasl-op #-ecl 'load-op :allocation :class))) + ((sideway-operation :initform #+(or ecl mkcl) 'load-fasl-op #-(or ecl mkcl) 'load-op :allocation :class))) (defclass lib-op (link-op gather-op non-propagating-operation) ((bundle-type :initform :lib)) @@ -87,7 +98,7 @@ itself.")) ;; operation on a system and its dependencies ((selfward-operation :initform '(prepare-fasl-op #+ecl lib-op) :allocation :class))) (defclass load-fasl-op (basic-load-op selfward-operation) - ((selfward-operation :initform '(prepare-op fasl-op) :allocation :class))) + ((selfward-operation :initform '(prepare-fasl-op fasl-op) :allocation :class))) ;; NB: since the monolithic-op's can't be sideway-operation's, ;; if we wanted lib-op, dll-op, deliver-asd-op to be sideway-operation's, @@ -123,7 +134,7 @@ itself.")) ;; operation on a system and its dependencies (defclass image-op (monolithic-bundle-op selfward-operation #+ecl link-op #+(or ecl mkcl) gather-op) ((bundle-type :initform :image) - (selfward-operation :initform '(#-ecl load-op) :allocation :class)) + (selfward-operation :initform '(#-(or ecl mkcl) load-op) :allocation :class)) (:documentation "create an image file from the system and its dependencies")) (defclass program-op (image-op) @@ -139,8 +150,9 @@ itself.")) ;; operation on a system and its dependencies ((member :dll :lib :shared-library :static-library :program :object :program) (compile-file-type :type bundle-type)) ((member :image) "image") - ((eql :dll) (cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll"))) - ((member :lib :static-library) (cond ((os-unix-p) "a") ((os-windows-p) "lib"))) + ((member :dll :shared-library) (cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll"))) + ((member :lib :static-library) (cond ((os-unix-p) "a") + ((os-windows-p) (if (featurep '(:or :mingw32 :mingw64)) "a" "lib")))) ((eql :program) (cond ((os-unix-p) nil) ((os-windows-p) "exe"))))) (defun bundle-output-files (o c) @@ -157,10 +169,11 @@ itself.")) ;; operation on a system and its dependencies (bundle-output-files o c)) #-(or ecl mkcl) - (defmethod perform ((o program-op) (c system)) - (let ((output-file (output-file o c))) - (setf *image-entry-point* (ensure-function (component-entry-point c))) - (dump-image output-file :executable t))) + (progn + (defmethod perform ((o image-op) (c system)) + (dump-image (output-file o c) :executable (typep o 'program-op))) + (defmethod perform :before ((o program-op) (c system)) + (setf *image-entry-point* (ensure-function (component-entry-point c))))) (defclass compiled-file (file-component) ((type :initform #-(or ecl mkcl) (compile-file-type) #+(or ecl mkcl) "fasb"))) @@ -189,14 +202,14 @@ itself.")) ;; operation on a system and its dependencies (unless name-suffix-p (setf (slot-value instance 'name-suffix) (unless (typep instance 'program-op) - (if (operation-monolithic-p instance) "--all-systems" #-ecl "--system")))) ; . no good for Logical Pathnames + (if (operation-monolithic-p instance) "--all-systems" #-(or ecl mkcl) "--system")))) ; . no good for Logical Pathnames (when (typep instance 'monolithic-bundle-op) (destructuring-bind (&key lisp-files prologue-code epilogue-code &allow-other-keys) (operation-original-initargs instance) (setf (prologue-code instance) prologue-code (epilogue-code instance) epilogue-code) - #-ecl (assert (null (or lisp-files epilogue-code prologue-code))) + #-ecl (assert (null (or lisp-files #-mkcl epilogue-code #-mkcl prologue-code))) #+ecl (setf (bundle-op-lisp-files instance) lisp-files))) (setf (bundle-op-build-args instance) (remove-plist-keys @@ -208,7 +221,9 @@ itself.")) ;; operation on a system and its dependencies (declare (ignorable type)) (or #+ecl (or (equalp type (compile-file-type :type :object)) (equalp type (compile-file-type :type :static-library))) - #+mkcl (equalp type (compile-file-type :fasl-p nil)) + #+mkcl (or (equalp type (compile-file-type :fasl-p nil)) + #+(or unix mingw32 mingw64) (equalp type "a") ;; valid on Unix and MinGW + #+(and windows (not (or mingw32 mingw64))) (equalp type "lib")) #+(or abcl allegro clisp clozure cmu lispworks sbcl scl xcl) (equalp type (compile-file-type))))) (defgeneric* (trivial-system-p) (component)) @@ -337,14 +352,23 @@ itself.")) ;; operation on a system and its dependencies (defmethod trivial-system-p ((s prebuilt-system)) t) + (defmethod perform ((o link-op) (c prebuilt-system)) + nil) + + (defmethod perform ((o basic-fasl-op) (c prebuilt-system)) + nil) + (defmethod perform ((o lib-op) (c prebuilt-system)) nil) - (defmethod component-depends-on ((o lib-op) (c prebuilt-system)) + (defmethod perform ((o dll-op) (c prebuilt-system)) nil) - (defmethod component-depends-on ((o monolithic-lib-op) (c prebuilt-system)) - nil)) + (defmethod component-depends-on ((o gather-op) (c prebuilt-system)) + nil) + + (defmethod output-files ((o lib-op) (c prebuilt-system)) + (values (list (prebuilt-system-static-library c)) t))) ;;; @@ -361,6 +385,7 @@ itself.")) ;; operation on a system and its dependencies (library (second inputs)) (asd (first (output-files o s))) (name (if (and fasl asd) (pathname-name asd) (return-from perform))) + (version (component-version s)) (dependencies (if (operation-monolithic-p o) (remove-if-not 'builtin-system-p @@ -390,6 +415,7 @@ itself.")) ;; operation on a system and its dependencies (let ((*package* (find-package :asdf-user))) (pprint `(defsystem ,name :class prebuilt-system + :version ,version :depends-on ,depends-on :components ((:compiled-file ,(pathname-name fasl))) ,@(when library `(:lib ,(file-namestring library)))) @@ -430,7 +456,7 @@ itself.")) ;; operation on a system and its dependencies (asdf:load-system :precompiled-asdf-utils) |# -#+(or ecl mkcl) +#+ecl (with-upgradability () (defun uiop-library-file () (or (and (find-system :uiop nil) @@ -447,8 +473,10 @@ itself.")) ;; operation on a system and its dependencies (and (system-source-directory :asdf) (plan-operates-on-p plan '("asdf")))) (pushnew (uiop-library-file) files :test 'pathname-equal)) - files)) + files))) +#+(or ecl mkcl) +(with-upgradability () (defun register-pre-built-system (name) (register-system (make-instance 'system :name (coerce-name name) :source-file nil)))) @@ -464,27 +492,41 @@ itself.")) ;; operation on a system and its dependencies (let* ((object-files (input-files o c)) (output (output-files o c)) (bundle (first output)) - (targetp (eq (type-of o) (component-build-operation c))) + (programp (typep o 'program-op)) (kind (bundle-type o))) (when output (apply 'create-image bundle (append object-files (bundle-op-lisp-files o)) :kind kind - :prologue-code (or (prologue-code o) (when targetp (prologue-code c))) - :epilogue-code (or (epilogue-code o) (when targetp (epilogue-code c))) + :prologue-code (or (prologue-code o) (when programp (prologue-code c))) + :epilogue-code (or (epilogue-code o) (when programp (epilogue-code c))) :build-args (bundle-op-build-args o) - (when targetp `(:entry-point ,(component-entry-point c)))))))) + (when programp `(:entry-point ,(component-entry-point c)))))))) #+mkcl (with-upgradability () + (defmethod perform ((o dll-op) (s system)) + (apply #'compiler::build-shared-library (output-file o s) + :lisp-object-files (input-files o s) (bundle-op-build-args o))) + (defmethod perform ((o lib-op) (s system)) - (apply #'compiler::build-static-library (output-file o c) + (apply #'compiler::build-static-library (output-file o s) :lisp-object-files (input-files o s) (bundle-op-build-args o))) (defmethod perform ((o basic-fasl-op) (s system)) - (apply #'compiler::build-bundle (output-file o c) ;; second??? + (apply #'compiler::build-bundle (output-file o s) :lisp-object-files (input-files o s) (bundle-op-build-args o))) + (defmethod perform ((o program-op) (s system)) + (apply #'compiler::build-program (output-file o s) + :lisp-object-files (append (program-prefix-lisp-object-files s) + (input-files o s) + (program-postfix-lisp-object-files s)) + :object-files (program-object-files s) + :prologue-code (prologue-code s) + :epilogue-code (epilogue-code s) + (program-extra-build-args s))) + (defun bundle-system (system &rest args &key force (verbose t) version &allow-other-keys) (declare (ignore force verbose version)) (apply #'operate 'deliver-asd-op system args))) diff --git a/cache.lisp b/cache.lisp index 4ca218f4eb50b8f6a2e370980960dfe095a46d21..dac44e2f17a4b2ea8d7dfe14bceb36c331f4ff0a 100644 --- a/cache.lisp +++ b/cache.lisp @@ -4,7 +4,8 @@ (uiop/package:define-package :asdf/cache (:use :uiop/common-lisp :uiop :asdf/upgrade) (:export #:get-file-stamp #:compute-file-stamp #:register-file-stamp - #:consult-asdf-cache #:do-asdf-cache #:normalize-namestring + #: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*)) (in-package :asdf/cache) @@ -22,6 +23,10 @@ (setf (gethash key *asdf-cache*) value-list) value-list))) + (defun unset-asdf-cache-entry (key) + (when *asdf-cache* + (remhash key *asdf-cache*))) + (defun consult-asdf-cache (key &optional thunk) (if *asdf-cache* (multiple-value-bind (results foundp) (gethash key *asdf-cache*) @@ -33,14 +38,15 @@ (defmacro do-asdf-cache (key &body body) `(consult-asdf-cache ,key #'(lambda () ,@body))) - (defun call-with-asdf-cache (thunk &key override) - (if (and *asdf-cache* (not override)) - (funcall thunk) - (let ((*asdf-cache* (make-hash-table :test 'equal))) - (funcall thunk)))) + (defun call-with-asdf-cache (thunk &key override key) + (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))))) - (defmacro with-asdf-cache ((&key override) &body body) - `(call-with-asdf-cache #'(lambda () ,@body) :override ,override)) + (defmacro with-asdf-cache ((&key key override) &body body) + `(call-with-asdf-cache #'(lambda () ,@body) :override ,override :key ,key)) (defun normalize-namestring (pathname) (let ((resolved (resolve-symlinks* diff --git a/concatenate-source.lisp b/concatenate-source.lisp index 3c7258dad6ff8c04917cb17dcb05e6dbd20b53dc..a2eb5d6d96b46fb9d1e12c10036b98470b22ad26 100644 --- a/concatenate-source.lisp +++ b/concatenate-source.lisp @@ -77,9 +77,11 @@ (lisp-compilation-output-files o s)) (defmethod perform ((o basic-concatenate-source-op) (s system)) - (let ((inputs (input-files o s)) - (output (output-file o s))) - (concatenate-files inputs output))) + (let* ((ins (input-files o s)) + (out (output-file o s)) + (tmp (tmpize-pathname out))) + (concatenate-files ins tmp) + (rename-file-overwriting-target tmp out))) (defmethod perform ((o basic-load-concatenated-source-op) (s system)) (perform-lisp-load-source o s)) (defmethod perform ((o basic-compile-concatenated-source-op) (s system)) diff --git a/debian/changelog b/debian/changelog index fca381a712562ffcfe49af113c845c9887d275f2..ee8179d133c5407bff7b509da6a33328d4f6d604 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,6 +1,8 @@ cl-asdf (2:3.1.1-1) unstable; urgency=low New release: + * ~/common-lisp/ is now present by default in the source-registry, so + you don't need to configure anything if you put source code there. * asdf-package-system combines the one-file, one-package, one-system paradigm of quick-build and faslpath with the portability and robustness of ASDF 3. * non-propagating-operation replaces OPERATION for operations as a base class @@ -13,9 +15,12 @@ cl-asdf (2:3.1.1-1) unstable; urgency=low set (represented as an equal hash-table) *immutable-systems* are always forced-not, and even their .asd is not refreshed from the filesystem. * portability is much improved, with support for the latest GCL, and - fixes for ABCL, CLISP, ECL, LispWorks, SBCL, XCL, etc. + fixes for ABCL, CLISP, ECL, LispWorks, MKCL, SBCL, XCL, etc. * bundle support was refactored; ECL support is fixed; - image-op added to create heap images for use with e.g. cl-launch. + image-op was added to create heap images for use with e.g. cl-launch. + load-fasl-op was renamed to load-bundle-op, fasl-op to compile-bundle-op, + binary-op to deliver-asd-op, and so forth for the monolithic- variants; + previous names remain available for backward compatibility. * robustness: Test improvements. Added missing dependencies in asdf.asd(!). Fixes to version-satisfies (thanks to stassats), to the file-stamp cache. Fixes regression from 3.0.2.12 whereby ASDF failed to avoid downgrading. @@ -29,14 +34,14 @@ cl-asdf (2:3.1.1-1) unstable; urgency=low previously loaded systems will not be cleared anymore, variables defined with defparameter* will not be reset. Punting on upgrades from ASDF 1 for more robust behavior. - * uiop much improved so as to be used with Google's build system: + * uiop much improved so as to be used with Google's build system blaze: with-temporary-file, dump-image / restore-image, ensure-pathname, compile-file*, with-saved-deferred-warnings. * asdf3.1 feature pushed, to signal the slew of significant improvements in over a year since initial ASDF 3.0 pre-release (i.e. version 2.27). * Documentation updated. TODO updated. - -- Francois-Rene Rideau <fare@tunes.org> Sun, 02 Mar 2014 01:09:06 -0500 + -- Francois-Rene Rideau <fare@tunes.org> Sun, 23 Mar 2014 19:00:06 -0400 cl-asdf (2:3.0.3-1) unstable; urgency=low diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index f3c7304209e432de8a785d842f6e26c8ac8c7363..5be2ffe867ce112545ba2c42abe99fcfbfcc0fb5 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -246,8 +246,9 @@ we recommend you upgrade to ASDF 3 --- and we explain how to do that. @xref{Loading ASDF}. (In the context of compatibility requirements, ASDF 2.27, released on Feb 1st 2013, and further 2.x releases up to 2.33, -count as pre-releases of ASDF 3, and define the :asdf3 feature; +count as pre-releases of ASDF 3, and define the @code{:asdf3} feature; still, please use the latest release). +Release ASDF 3.1.1 and later also define the @code{:asdf3.1} feature. Also note that ASDF is not to be confused with ASDF-Install. ASDF-Install is not part of ASDF, but a separate piece of software. @@ -256,6 +257,9 @@ We recommend you use Quicklisp instead, which works great and is being actively maintained. If you want to download software from version control instead of tarballs, so you may more easily modify it, we recommend clbuild. +We recommend @file{~/common-lisp/} +as a place into which to install Common Lisp software; +starting with ASDF 3.1.1, it is included in the default source-registry configuration. @node Quick start summary, Loading ASDF, Introduction, Top @chapter Quick start summary @@ -276,7 +280,9 @@ Make sure ASDF can find system definitions through proper source-registry configuration. For more details, @xref{Configuring ASDF to find your systems}. The simplest way is simply to put all your lisp code in subdirectories of -@file{~/.local/share/common-lisp/source/}. +@file{~/common-lisp/} (starting with ASDF 3.1.1), +or @file{~/.local/share/common-lisp/source/} +(for ASDF 2 and later, or if you want to keep source in a hidden directory). Such code will automatically be found. @item @@ -433,10 +439,12 @@ we assume you're an expert deliberately using a legacy implementation, and are proficient enough to install this fasl. Still, the ASDF source repository contains a script @file{bin/install-asdf-as-module} that can help you do that. -It relies on cl-launch 4 for command-line invocation, +It relies on @file{cl-launch} 4 for command-line invocation, which may depend on ASDF being checked out in @file{~/cl/asdf/} if your implementation doesn't even have an ASDF 2; -but you can run the code it manually if needs be. +but if you don't have @file{cl-launch}, +you can instead @code{(load "bin/install-asdf-as-module")} +from your implementation's REPL. Finally, if your implementation only provides ASDF 2, and you can't or won't upgrade it or override its ASDF module, @@ -553,7 +561,7 @@ and resetting the ASDF configuration is usually only needed in corner cases. * Resetting the ASDF configuration:: @end menu -@node Configuring ASDF to find your systems, Configuring where ASDF stores object files, Configuring ASDF, Configuring ASDF +@node Configuring ASDF to find your systems, Configuring ASDF to find your systems --- old style, Configuring ASDF, Configuring ASDF @section Configuring ASDF to find your systems In order to compile and load your systems, ASDF must be configured to find @@ -566,9 +574,11 @@ ASDF, starting from easiest to the most complex: @item Put all of your systems in subdirectories of +@file{~/common-lisp/} or @file{~/.local/share/common-lisp/source/}. -If you install software there (it can be a symlink), -you don't need further configuration. +If you install software there, you don't need further configuration. +(NB: @file{~/common-lisp/} is only included in the default configuration +starting with ASDF 3.1.1 or later) @item If you're using some tool to install software (e.g. Quicklisp), @@ -615,16 +625,6 @@ If necessary, you can reset the source-registry configuration with: (asdf:clear-source-registry) @end lisp -@c FIXME: too specific. Push this down to discussion of dumping an -@c image? - -@c And you probably should do so before you dump your Lisp image, -@c if the configuration may change -@c between the machine where you save it at the time you save it -@c and the machine you resume it at the time you resume it. -@c Actually, you should use @code{(asdf:clear-configuration)} -@c before you dump your Lisp image, which includes the above. - @item In earlier versions of ASDF, the system source registry was configured using a global variable, @code{asdf:*central-registry*}. @@ -731,7 +731,7 @@ but it is supported for old users, and for users who want to programmatically control what directories are added to the ASDF search path. -@node Configuring where ASDF stores object files, , Configuring ASDF to find your systems, Configuring ASDF +@node Configuring where ASDF stores object files, Resetting the ASDF configuration, Configuring ASDF to find your systems --- old style, Configuring ASDF @section Configuring where ASDF stores object files @findex clear-output-translations @@ -828,19 +828,15 @@ For that you may use the following function: regarding source-registry or output-translations. @end defun -If you use SBCL, CMUCL or SCL, you may use this snippet -so that the ASDF configuration be cleared automatically as you dump an image: - -@example -#+(or cmu sbcl scl) -(pushnew 'clear-configuration - #+(or cmu scl) ext:*before-save-initializations* - #+sbcl sb-ext:*save-hooks*) -@end example - -For compatibility with all Lisp implementations, however, -you might want instead your build script to explicitly call -@code{(asdf:clear-configuration)} at an appropriate moment before dumping. +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}, +it will be automatically called to clear your configuration. +If for some reason you prefer to call your implementation's underlying functionality, +be sure to call @code{clear-configuration} manually, +or push it into your implementation's equivalent of @code{uiop:*image-dump-hook*}, +e.g. @code{sb-ext:*save-hooks*} on SBCL, or @code{ext:*before-save-initializations*} +on CMUCL and SCL, etc. @node Using ASDF, Defining systems with defsystem, Configuring ASDF, Top @chapter Using ASDF diff --git a/doc/index.html b/doc/index.html index 0e6afb015d01100d1d225ec92017280d8295d9cd..338d70cb3c221250c609d9bef20e136f24801236 100644 --- a/doc/index.html +++ b/doc/index.html @@ -4,6 +4,7 @@ <title>ASDF - Another System Definition Facility</title> <link type='text/css' href='style.css' rel='stylesheet' /> <meta name="author" content="the ASDF group"/> + <meta http-equiv="Content-Type" content="text/html; charset=utf-8"> </head> <body> <div class="header"> @@ -104,23 +105,26 @@ packages you need to modify or want to contribute to. We recommend you should <em>not</em> use <tt>asdf-install</tt> anymore, as it is an older similar piece of software that is both unmaintained and obsolete. + </p><p> + ASDF is also not a tool to build or run Common Lisp software from the Unix command-line. + For that, you want <a href="http://cliki.net/cl-launch">cl-launch</a>, + or perhaps <a href="http://www.xach.com/lisp/buildapp/">buildapp</a>. </p><p> If you're unsatisfied with ASDF, beside helping with our <a href="http://common-lisp.net/gitweb?p=projects/asdf/asdf.git;a=blob;f=TODO">TODO list</a>, you might be interested in other build systems for Common-Lisp: <ul> - <li>Alastair Bridgewater's small and simpler one-package-per-file + <li>Alastair Bridgewater's small and simple one-package-per-file <a href="https://bugs.launchpad.net/asdf/+bug/1230368"><tt>quick-build</tt></a> - (similar to <tt>faslpath</tt> below, - also reimplemented as the ASDF extension + (also reimplemented as the ASDF extension <a href="http://common-lisp.net/gitweb?p=projects/asdf/asdf-package-system.git" - ><tt>asdf-package-system</tt></a>). + ><tt>asdf-package-system</tt></a>; similar to <tt>faslpath</tt> below). </li> <li>François-René Rideau's <a href="http://common-lisp.net/project/xcvb/"><tt>XCVB</tt></a> (trying to build object and image files deterministically and in parallel, - but not actively maintained since 2012). + but not actively maintained since 2012; ASDF could be modified ). </li> <li>Drew McDermott's <a href="http://cs-www.cs.yale.edu/homes/dvm/"><tt>YTools</tt></a> @@ -180,8 +184,8 @@ <th align="left">Will provide it</th> <th align="left">Obsolete</th></tr> <tr><th align="left">Free</th> - <td align="left"><tt>abcl ccl clisp cmucl ecl sbcl</tt></td> - <td align="left"><tt>mkcl xcl</tt></td> + <td align="left"><tt>abcl ccl clisp cmucl ecl mkcl sbcl</tt></td> + <td align="left"><tt>xcl</tt></td> <td> </td> <td align="left"><tt>gcl mcl</tt></td></tr> <tr><th align="left">Proprietary</th> @@ -192,7 +196,7 @@ </table> <p> To deal with an implementation that doesn't yet provide ASDF 3, - we provide a script that can install ASDF 3 + we provide <a href="http://common-lisp.net/gitweb?p=projects/asdf/asdf.git;a=blob;f=bin/install-asdf-as-module">a script</a> that can install ASDF 3 where your implementation goes looking for it when you <tt>require</tt> it. Alternatively, if the implementation provides ASDF 2 or an older ASDF 3, @@ -325,14 +329,15 @@ Peter Graves <gnooth@gmail.com> (XCL). that also determines dependencies, in the style of <a href="https://bugs.launchpad.net/asdf/+bug/1230368"><tt>quick-build</tt></a> or <a href="http://www.cliki.net/faslpath"><tt>faslpath</tt></a> - (this functionality is built into recent ASDF releases, + (this functionality is built into recent versions of ASDF 3.1 and later, but this package exists for backward compatibility with earlier versions of ASDF 3). </ul> <p>Former extensions, now superseded, include:</p> <ul> <li><tt>asdf-binary-locations</tt> allowed one to redirect where ASDF creates its output files, so they don't clash between implementations and don't pollute source directories. - It is superseded by <tt>asdf/defsystem</tt> builtin <tt>asdf-output-translations</tt> mechanism; + It is superseded by <tt>asdf/defsystem</tt>'s builtin + <tt>asdf-output-translations</tt> mechanism; a limited compatibility mode is available to easily convert your former ABL configuration into an AOT configuration. <tt>common-lisp-controller</tt> and <tt>cl-launch</tt> used to provide similar mechanisms, @@ -343,7 +348,8 @@ Peter Graves <gnooth@gmail.com> (XCL). for easier delivery. It is now a builtin part of <tt>asdf/defsystem</tt>, and allows to deliver a single FASL for a system, - or (on supported implementations), a standalone executable program. + or (on supported implementations), a standalone executable program, + or an image containing part of your software precompiled. </li> <li><tt>asdf-utils</tt> was a collection of utilities that originated with ASDF. It is now superseded by <tt>uiop</tt>, aka <tt>asdf/driver</tt>, @@ -461,7 +467,7 @@ Peter Graves <gnooth@gmail.com> (XCL). <a class="nav" href="http://common-lisp.net/" title="Common-Lisp.net"> <img src="http://common-lisp.net/project/cl-containers/shared/buttons/lisp-lizard.png" width="80" height="15" title="Common-Lisp.net" alt="Common-Lisp.net button" /></a> <p><span class="copyright"Copyright © 2001-2014 Daniel Barlow and contributors</span></p> <p>ASDF has an <a href="http://www.opensource.org/licenses/mit-license.php">MIT style</a> license</p> - <div id="timestamp">Last updated 2014-03-02</div> + <div id="timestamp">Last updated 2014-03-22</div> </div> </body> </html> diff --git a/find-component.lisp b/find-component.lisp index 89108aedc702347518c181bb2fae558e9d52780c..4395648b8492af087aa4d9b14badb8708868fc94 100644 --- a/find-component.lisp +++ b/find-component.lisp @@ -3,7 +3,7 @@ (uiop/package:define-package :asdf/find-component (:recycle :asdf/find-component :asdf) - (:use :uiop/common-lisp :uiop :asdf/upgrade + (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/cache :asdf/component :asdf/system :asdf/find-system) (:export #:find-component @@ -106,7 +106,12 @@ (or (null c) (and (typep c 'missing-dependency) (eq (missing-required-by c) component) - (equal (missing-requires c) name)))))))) + (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)))))))) + (defun resolve-dependency-spec (component dep-spec) (let ((component (find-component () component))) diff --git a/find-system.lisp b/find-system.lisp index 564d13507131f06c20a45ba6d326dd427ea4f23a..fde016c3dc59793d97ab4b57cc639eb68b40b768 100644 --- a/find-system.lisp +++ b/find-system.lisp @@ -4,21 +4,21 @@ (uiop/package:define-package :asdf/find-system (:recycle :asdf/find-system :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade - :asdf/component :asdf/system :asdf/cache) + :asdf/cache :asdf/component :asdf/system) (:export #:remove-entry-from-registry #:coerce-entry-to-directory #:coerce-name #:primary-system-name #:coerce-filename - #:find-system #:locate-system #:load-asd #:with-system-definitions + #:find-system #:locate-system #:load-asd #:system-registered-p #:register-system #:registered-systems #:clear-system #:map-systems #:missing-component #:missing-requires #:missing-parent #:formatted-system-definition-error #:format-control #:format-arguments #:sysdef-error #:load-system-definition-error #:error-name #:error-pathname #:error-condition #:*system-definition-search-functions* #:search-for-system-definition #:*central-registry* #:probe-asd #:sysdef-central-registry-search - #:find-system-if-being-defined #:*systems-being-defined* + #:find-system-if-being-defined #:contrib-sysdef-search #:sysdef-find-asdf ;; backward compatibility symbols, functions removed #:sysdef-preloaded-system-search #:register-preloaded-system #:*preloaded-systems* - #:clear-defined-systems #:*defined-systems* + #:clear-defined-system #:clear-defined-systems #:*defined-systems* #:*immutable-systems* ;; defined in source-registry, but specially mentioned here: #:initialize-source-registry #:sysdef-source-registry-search)) @@ -89,15 +89,18 @@ of which is a system object.") (get-file-stamp file)) system))))) + (defun clear-defined-system (system) + (let ((name (coerce-name system))) + (remhash name *defined-systems*) + (unset-asdf-cache-entry `(locate-system ,name)) + (unset-asdf-cache-entry `(find-system ,name)) + nil)) + (defun clear-defined-systems () ;; Invalidate all systems but ASDF itself, if registered. - (let ((asdf (cdr (system-registered-p :asdf)))) - (setf *defined-systems* (make-hash-table :test 'equal)) - (when asdf - (setf (component-version asdf) *asdf-version*) - (setf (builtin-system-p asdf) t) - (register-system asdf))) - (values)) + (loop :for name :being :the :hash-keys :of *defined-systems* + :unless (equal name "asdf") + :do (clear-defined-system name))) (register-hook-function '*post-upgrade-cleanup-hook* 'clear-defined-systems nil) @@ -254,32 +257,13 @@ Going forward, we recommend new users should be using the source-registry. (defmethod find-system (name &optional (error-p t)) (find-system (coerce-name name) error-p)) - (defvar *systems-being-defined* nil - "A hash-table of systems currently being defined keyed by name, or NIL") - (defun find-system-if-being-defined (name) - (when *systems-being-defined* - ;; notable side effect: mark the system as being defined, to avoid infinite loops - (ensure-gethash (coerce-name name) *systems-being-defined* nil))) - - (defun call-with-system-definitions (thunk) - (if *systems-being-defined* - (call-with-asdf-cache thunk) - (let ((*systems-being-defined* (make-hash-table :test 'equal))) - (call-with-asdf-cache thunk)))) - - (defun clear-systems-being-defined () - (when *systems-being-defined* - (clrhash *systems-being-defined*))) - - (register-hook-function '*post-upgrade-cleanup-hook* 'clear-systems-being-defined) - - (defmacro with-system-definitions ((&optional) &body body) - `(call-with-system-definitions #'(lambda () ,@body))) + ;; notable side effect: mark the system as being defined, to avoid infinite loops + (first (gethash `(find-system ,(coerce-name name)) *asdf-cache*))) (defun load-asd (pathname &key name (external-format (encoding-external-format (detect-encoding pathname))) &aux (readtable *readtable*) (print-pprint-dispatch *print-pprint-dispatch*)) ;; Tries to load system definition with canonical NAME from PATHNAME. - (with-system-definitions () + (with-asdf-cache () (with-standard-io-syntax (let ((*package* (find-package :asdf-user)) ;; Note that our backward-compatible *readtable* is @@ -374,41 +358,41 @@ PATHNAME when not null is a path from where 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." - (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))) + (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)))) (defmethod find-system ((name string) &optional (error-p t)) - (with-system-definitions () + (with-asdf-cache (:key `(find-system ,name)) (let ((primary-name (primary-system-name name))) - (unless (or (equal name primary-name) - (nth-value 1 (gethash primary-name *systems-being-defined*))) + (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 (gethash name *systems-being-defined*) + (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))) @@ -442,5 +426,6 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (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))))))) diff --git a/footer.lisp b/footer.lisp index f824748c714fbc0cfa4f1a6d792f24ab352fa94b..f90c8ef47782c06aedc85d710621eb081414800c 100644 --- a/footer.lisp +++ b/footer.lisp @@ -20,7 +20,7 @@ #+(or ecl mkcl) (progn - (pushnew '("fasb" . si::load-binary) si:*load-hooks* :test 'equal :key 'car) + (pushnew '("fasb" . si::load-binary) si::*load-hooks* :test 'equal :key 'car) #+(or (and ecl win32) (and mkcl windows)) (unless (assoc "asd" #+ecl ext:*load-hooks* #+mkcl si::*load-hooks* :test 'equal) diff --git a/header.lisp b/header.lisp index 8ecca81f68e46a2f5910f5d31aeb4afd729bcdd9..be979702d3ccf62a037733a3d0003c26fc447d77 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.0.94: Another System Definition Facility. +;;; This is ASDF 3.1.0.102: 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 8767a55c0149ffd9ba008864da77fb46f7a3e50e..2bc43bbd030b6f00a84b11104902bef43d21e726 100644 --- a/interface.lisp +++ b/interface.lisp @@ -5,22 +5,20 @@ (:nicknames :asdf :asdf-utilities) (:recycle :asdf/interface :asdf) (:unintern - #:*asdf-revision* #:around #:asdf-method-combination - #:do-traverse #:do-dep #:do-one-dep #:visit-action #:component-visited-p - #:split #:make-collector #:loaded-systems ; makes for annoying SLIME completion - #:output-files-for-system-and-operation) ; obsolete ASDF-BINARY-LOCATION function + #:output-files-for-system-and-operation) ; ASDF-BINARY-LOCATION function we use to detect ABL (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/cache :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/operation :asdf/action :asdf/lisp-action :asdf/output-translations :asdf/source-registry :asdf/plan :asdf/operate :asdf/parse-defsystem :asdf/bundle :asdf/concatenate-source :asdf/backward-internals :asdf/backward-interface :asdf/package-system) - ;; TODO: automatically generate interface with reexport? + ;; Note: (1) we are NOT automatically reexporting everything from previous packages. + ;; (2) we only reexport UIOP functionality when backward-compatibility requires it. (:export #:defsystem #:find-system #:locate-system #:coerce-name #:primary-system-name #:oos #:operate #:make-plan #:perform-plan #:sequential-plan - #:system-definition-pathname #:with-system-definitions + #:system-definition-pathname #:search-for-system-definition #:find-component #:component-find-path #:compile-system #:load-system #:load-systems #:load-systems* #:require-system #:test-system #:clear-system @@ -32,10 +30,9 @@ #:prepare-source-op #:load-source-op #:test-op #:feature #:version #:version-satisfies #:upgrade-asdf #:implementation-identifier #:implementation-type #:hostname - #:input-files #:output-files #:output-file #:perform + #:input-files #:output-files #:output-file #:perform #:perform-with-restarts #:operation-done-p #:explain #:action-description #:component-sideway-dependencies #:needed-in-image-p - ;; #:run-program ; we can't export it, because SB-GROVEL :use's both ASDF and SB-EXT. #:component-load-dependencies #:run-shell-command ; deprecated, do not use #:bundle-op #:monolithic-bundle-op #:precompiled-system #:compiled-file #:bundle-system #+ecl #:make-build diff --git a/operate.lisp b/operate.lisp index be4b948ba5ecd6910eced58b7f74166a13fd2ff7..8d306d7d0ad53db91a31857ef8eff114ff36337c 100644 --- a/operate.lisp +++ b/operate.lisp @@ -3,7 +3,7 @@ (uiop/package:define-package :asdf/operate (:recycle :asdf/operate :asdf) - (:use :uiop/common-lisp :uiop :asdf/upgrade + (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/cache :asdf/component :asdf/system :asdf/operation :asdf/action :asdf/find-system :asdf/find-component :asdf/lisp-action :asdf/plan) (:export @@ -73,7 +73,7 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be: (return-from operate (apply 'operate (funcall operation-remaker) component-path keys)))) ;; Setup proper bindings around any operate call. - (with-system-definitions () + (with-asdf-cache () (let* ((*verbose-out* (and verbose *standard-output*)) (*compile-file-warnings-behaviour* on-warnings) (*compile-file-failure-behaviour* on-failure)) @@ -222,11 +222,11 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms.")) (with-upgradability () (defun restart-upgraded-asdf () ;; If we're in the middle of something, restart it. - (when *systems-being-defined* - (let ((l (loop :for name :being :the :hash-keys :of *systems-being-defined* :collect name))) - (clrhash *systems-being-defined*) + (when *asdf-cache* + (let ((l (loop* :for (x y) :being :the hash-keys :of *asdf-cache* + :when (eq x 'find-system) :collect y))) + (clrhash *asdf-cache*) (dolist (s l) (find-system s nil))))) - (register-hook-function '*post-upgrade-restart-hook* 'restart-upgraded-asdf)) diff --git a/parse-defsystem.lisp b/parse-defsystem.lisp index fed65fab2faba5fea9c948fc66e34cf3dda9cd92..49f2e12b1862129306367bb5c7d395bf6b055f6c 100644 --- a/parse-defsystem.lisp +++ b/parse-defsystem.lisp @@ -5,7 +5,7 @@ (:recycle :asdf/parse-defsystem :asdf/defsystem :asdf) (:nicknames :asdf/defsystem) ;; previous name, to be compatible with, in case anyone cares (:use :uiop/common-lisp :asdf/driver :asdf/upgrade - :asdf/component :asdf/system :asdf/cache + :asdf/cache :asdf/component :asdf/system :asdf/find-system :asdf/find-component :asdf/lisp-action :asdf/operate :asdf/backward-internals) (:import-from :asdf/system #:depends-on #:weakly-depends-on) @@ -237,8 +237,8 @@ system names contained using COERCE-NAME. Return the result." ;; of the same name to reuse options (e.g. pathname) from. ;; To avoid infinite recursion in cases where you defsystem a system ;; that is registered to a different location to find-system, - ;; we also need to remember it in a special variable *systems-being-defined*. - (with-system-definitions () + ;; we also need to remember it in the asdf-cache. + (with-asdf-cache () (let* ((name (coerce-name name)) (source-file (if sfp source-file (resolve-symlinks* (load-pathname)))) (registered (system-registered-p name)) @@ -257,7 +257,7 @@ system names contained using COERCE-NAME. Return the result." (setf component-options (append `(:defsystem-depends-on ,(parse-dependency-defs defsystem-depends-on)) component-options))) - (setf (gethash name *systems-being-defined*) system) + (set-asdf-cache-entry `(find-system ,name) (list system)) (load-systems* defsystem-dependencies) ;; We change-class AFTER we loaded the defsystem-depends-on ;; since the class might be defined as part of those. diff --git a/source-registry.lisp b/source-registry.lisp index 70bac4b96807acd04019dccdbb68666788cc73f3..d85285fdb052002cdd4a0602f035397121f01d34 100644 --- a/source-registry.lisp +++ b/source-registry.lisp @@ -16,7 +16,8 @@ #:collect-asds-in-directory #:collect-sub*directories-asd-files #:validate-source-registry-directive #:validate-source-registry-form #:validate-source-registry-file #:validate-source-registry-directory - #:parse-source-registry-string #:wrapping-source-registry #:default-source-registry + #:parse-source-registry-string #:wrapping-source-registry + #:default-user-source-registry #:default-system-source-registry #:user-source-registry #:system-source-registry #:user-source-registry-directory #:system-source-registry-directory #:environment-source-registry #:process-source-registry @@ -145,9 +146,11 @@ system names to pathnames of .asd files") '(environment-source-registry user-source-registry user-source-registry-directory + default-user-source-registry system-source-registry system-source-registry-directory - default-source-registry)) + default-system-source-registry) + "List of default source registries" "3.1.0.102") (defparameter *source-registry-file* (parse-unix-namestring "source-registry.conf")) (defparameter *source-registry-directory* (parse-unix-namestring "source-registry.conf.d/")) @@ -155,21 +158,31 @@ system names to pathnames of .asd files") (defun wrapping-source-registry () `(:source-registry #+(or ecl sbcl) (:tree ,(resolve-symlinks* (lisp-implementation-directory))) - #+mkcl (:tree ,(translate-logical-pathname "CONTRIB:")) :inherit-configuration + #+mkcl (:tree ,(translate-logical-pathname "CONTRIB:")) #+cmu (:tree #p"modules:") #+scl (:tree #p"file://modules/"))) - (defun default-source-registry () + (defun default-user-source-registry () `(:source-registry - #+sbcl (:directory ,(subpathname (user-homedir-pathname) ".sbcl/systems/")) + (:tree (:home "common-lisp/")) + #+sbcl (:directory (:home ".sbcl/systems/")) ,@(loop :for dir :in `(,@(when (os-unix-p) `(,(or (getenv-absolute-directory "XDG_DATA_HOME") - (subpathname (user-homedir-pathname) ".local/share/")) - ,@(or (getenv-absolute-directories "XDG_DATA_DIRS") - '("/usr/local/share" "/usr/share")))) + (subpathname (user-homedir-pathname) ".local/share/")))) + ,@(when (os-windows-p) + (mapcar 'get-folder-path '(:local-appdata :appdata)))) + :collect `(:directory ,(subpathname* dir "common-lisp/systems/")) + :collect `(:tree ,(subpathname* dir "common-lisp/source/"))) + :inherit-configuration)) + (defun default-system-source-registry () + `(:source-registry + ,@(loop :for dir :in + `(,@(when (os-unix-p) + (or (getenv-absolute-directories "XDG_DATA_DIRS") + '("/usr/local/share" "/usr/share"))) ,@(when (os-windows-p) - (mapcar 'get-folder-path '(:local-appdata :appdata :common-appdata)))) + (list (get-folder-path :common-appdata)))) :collect `(:directory ,(subpathname* dir "common-lisp/systems/")) :collect `(:tree ,(subpathname* dir "common-lisp/source/"))) :inherit-configuration)) diff --git a/test/dll-test.lisp b/test/dll-test.lisp index ef251c3ee361664db099eb20d34fa7314ce386e3..5bf1f8633352b631bede6462685f7d8524bb5052 100644 --- a/test/dll-test.lisp +++ b/test/dll-test.lisp @@ -9,3 +9,13 @@ int sample_function() return 42; } ") + +#+mkcl +(ffi:clines " +extern MKCL_DLLEXPORT int sample_function(void); + +int sample_function(void) +{ + return 42; +} +") diff --git a/test/dll-user.lisp b/test/dll-user.lisp index a60d529a47a705c97a9e06ec678f04b6da611763..7bcc0c079d1155f92e2633c028fbb7f81920bb18 100644 --- a/test/dll-user.lisp +++ b/test/dll-user.lisp @@ -1,4 +1,10 @@ (defpackage :test-asdf/dll-user (:use)) ;; dummy, for package-system dependencies. (in-package :test-package) + +#+(and mkcl windows) +(ffi:clines "extern __declspec(dllimport) int sample_function(void);") +#-(and mkcl windows) +(ffi:clines "extern int sample_function(void);") + (ffi:def-function "sample_function" () :returning :int) diff --git a/test/hello-world-example.asd b/test/hello-world-example.asd index c1c5eaad57cefd3161940c9a5ea1b12400fd044a..90aa5556dead167a3fe6377b7a968ffe85c5699d 100644 --- a/test/hello-world-example.asd +++ b/test/hello-world-example.asd @@ -1,7 +1,14 @@ ;; Example executable program -(defsystem :hello-world-example - :build-operation program-op - :entry-point "hello:entry-point" - :depends-on (:uiop) - :components ((:file "hello"))) +#.`(defsystem :hello-world-example + ;; :build-operation program-op ; this would cause the executable output in same directory :-/ + :entry-point "hello:entry-point" + :depends-on (:uiop) + :components ((:file "hello")) + #+mkcl + ,@`(:prefix-lisp-object-files (,(namestring (truename (translate-logical-pathname #P"SYS:cmp.a")))) + :extra-build-args ,(or #-windows '(:use-mkcl-shared-libraries nil)) + :epilogue-code (progn + (setq uiop/image:*image-dumped-p* :executable) + (setq uiop/image:*lisp-interaction* nil) + (uiop/image:restore-image :entry-point (read-from-string "hello:entry-point"))))) diff --git a/test/make-hello-world.lisp b/test/make-hello-world.lisp index a51f7fac605320b02174f994690c5695b900a87a..48cfd706f044a14c41fdf0420ec93ba24abe7245 100644 --- a/test/make-hello-world.lisp +++ b/test/make-hello-world.lisp @@ -2,7 +2,7 @@ #+lispworks (lispworks:load-all-patches) (load (make-pathname :name "script-support" :defaults *load-pathname*)) (load-asdf) -#+ecl (require :cmp) +#+(or ecl mkcl) (require :cmp) (asdf-test::register-directory asdf-test::*asdf-directory*) ;; we need UIOP, and ECL can dump. (asdf-test::register-directory asdf-test::*uiop-directory*) @@ -10,8 +10,16 @@ (asdf-test::frob-packages) -(with-test () - ;;(dolist (s '(:asdf :uiop :asdf/defsystem :uiop)) (DBG :foo s (asdf::builtin-system-p (find-system s)))) - ;;(trace perform-plan perform) +(defun make-hello-image () (operate 'load-fasl-op :hello-world-example) - (operate 'program-op :hello-world-example)) + (operate 'image-op :hello-world-example)) + +(defun make-hello-program () + (operate 'load-fasl-op :hello-world-example) + (operate 'program-op :hello-world-example) + #+(and mkcl windows) ;; make sure mkcl-X.X.X.dll is the same directory as the executable + (let* ((dll-orig (subpathname (si::self-truename) + (strcat "mkcl_" (lisp-implementation-version) ".dll"))) + (exe (asdf::output-file 'program-op :hello-world-example)) + (dll-dest (subpathname exe dll-orig))) + (copy-file dll-orig dll-dest))) diff --git a/test/monodll-1.lisp b/test/monodll-1.lisp index f4cfa5faf8342bb502f0408e5bb06d55654a51f5..3de4d355bd7508f3165a8a9b9563d4bc7855329d 100644 --- a/test/monodll-1.lisp +++ b/test/monodll-1.lisp @@ -9,3 +9,13 @@ int always_7() return 7; } ") + +#+mkcl +(ffi:clines " +extern MKCL_DLLEXPORT int always_7(void); + +int always_7(void) +{ + return 7; +} +") diff --git a/test/monodll.lisp b/test/monodll.lisp index 1984900c37d08c116ab44883bcff911ac5f9452e..68b94f5dff8f76297686b84d4377111f8ef6b355 100644 --- a/test/monodll.lisp +++ b/test/monodll.lisp @@ -9,3 +9,13 @@ int always_42() return 6*always_7(); } ") + +#+mkcl +(ffi:clines " +extern MKCL_DLLEXPORT int always_42(void); + +int always_42(void) +{ + return 6*always_7(); +} +") diff --git a/test/run-tests.sh b/test/run-tests.sh index db96c629235ab744316211400185d9c1c44e488e..63d24a7009c582e84b17398f19d64e20407137c7 100755 --- a/test/run-tests.sh +++ b/test/run-tests.sh @@ -144,7 +144,7 @@ do_tests () { echo "Testing: $i" >&2 test_count=`expr "$test_count" + 1` rm -f ~/.cache/common-lisp/"`pwd`"/* || true - if DO $bcmd $eval "'(#.(load(string'|script-support.lisp|))#.(asdf-test::load-asdf)#.(asdf-test::frob-packages)#.(asdf-test::with-test()(load(string'|$i|))))" ; then + if DO $bcmd $eval "'(#.(load(string'|script-support.lisp|))#.(asdf-test::load-asdf)#.(asdf-test::frob-packages)#.(asdf-test:run-test-script'|$i|))" ; then echo "Using $command, $i passed" >&2 test_pass=`expr "$test_pass" + 1` else @@ -476,10 +476,10 @@ test_clean_load () { nop=build/results/${lisp}-nop.text load=build/results/${lisp}-load.text $bcmd $eval \ - "(or'#.(load(string'|test/script-support.lisp|):verbose():print())#.(asdf-test::exit-lisp'0))" \ + "(or'#.(load(string'|test/script-support.lisp|):verbose():print())#.(asdf-test:exit-lisp'0))" \ > $nop 2>&1 $bcmd $eval \ - "(or'#.(load(string'|test/script-support.lisp|):verbose():print())#.(asdf-test::verbose())#.(load(string'|build/asdf.lisp|):verbose())#.(asdf/image:quit'0))" \ + "(or'#.(load(string'|test/script-support.lisp|):verbose():print())#.(asdf-test:verbose())#.(load(string'|build/asdf.lisp|):verbose())#.(asdf/image:quit'0))" \ > $load 2>&1 if diff $nop $load ; then echo "GOOD: Loading ASDF on $lisp produces no message" >&2 ; return 0 @@ -492,13 +492,13 @@ test_load_systems () { mkdir -p build/results/ echo "Loading all these systems: $*" $bcmd $eval \ - "(or #.(load(string'|test/script-support.lisp|))#.(asdf-test::with-test()(asdf-test::test-load-systems $*)))" \ + "(or #.(load(string'|test/script-support.lisp|))#.(asdf-test:with-test()(asdf-test:test-load-systems $*)))" \ 2>&1 | tee build/results/${lisp}-systems.text } test_interactively () { cd ${ASDFDIR} mkdir -p build/results/ - rlwrap $icmd $eval "(or'#.(load(string'|test/script-support.lisp|))#.(asdf-test::interactive-test'($*)))" + rlwrap $icmd $eval "(or'#.(load(string'|test/script-support.lisp|))#.(asdf-test:interactive-test'($*)))" } if [ -z "$command" ] ; then diff --git a/test/script-support.lisp b/test/script-support.lisp index 0ab83108e079b10ac176eb21496163d48150c6be..6b0a4069d294afae386dc517ad38237a5c422b8b 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -24,6 +24,8 @@ Some constraints: #:load-asdf-system #:clean-load-asdf-system #:register-directory #:load-test-system #:with-test #:test-asdf #:debug-asdf + #:run-test-script #:interactive-test #:test-load-systems + #:verbose #:exit-lisp #:assert-compare #:assert-equal #:leave-test #:def-test-system @@ -142,6 +144,9 @@ Some constraints: (cond ((equal x y) (format t "~S and~% ~S both evaluate to same path:~% ~S~%" qx qy x)) + #+mkcl + ((acall :pathname-equal x y) + (format t "~S and ~S evaluate to functionaly equivalent paths, respectively:~% ~S~%and~% ~S~%" qx qy x y)) ((acall :pathname-equal x y) (warn "These two expressions yield pathname-equal yet not equal path~%~ the first expression ~S yields this:~% ~S~% ~S~% @@ -354,6 +359,12 @@ is bound, write a message and exit on an error. If (setf *package* (some 'find-package '(:asdf :uiop :asdf/utility :asdf/package :asdf-test))) (load "contrib/debug.lisp")) +(defun run-test-script (file) + (with-test () + (let ((name (string file))) + (format t "Running ~A with ~A~%" name (acall :implementation-identifier)) + (load name)))) + (defun load-asdf-lisp (&optional tag) (quietly (load (asdf-lisp tag) :verbose *load-verbose* :print *load-print*))) diff --git a/test/test-bundle.script b/test/test-bundle.script index 5669c83a325860fb27e12db6442d841247029d4e..42eb3a572dd5a5068ccf19b6488c3ece4c57a473 100644 --- a/test/test-bundle.script +++ b/test/test-bundle.script @@ -49,15 +49,27 @@ (operate 'monolithic-fasl-op :test-asdf/bundle-2) (assert (probe-file *mono-bundle-2*)) -;;; Test dll-op and monolithic-dll-op on ECL. -#+ecl +;;; Test dll-op and monolithic-dll-op on ECL and MKCL +#+(or ecl mkcl) (progn (require 'sockets) ;; Test the pre-compiled system feature (operate 'dll-op :test-asdf/dll-test) - (si:load-foreign-module (first (output-files 'dll-op :test-asdf/dll-test))) - (operate 'load-op :test-asdf/dll-user) + (let ((dll (first (output-files 'dll-op :test-asdf/dll-test)))) + (si:load-foreign-module dll) + (let* (#+(and mkcl windows) (compiler::*builder-default-libraries* (list (namestring dll)))) + (operate 'load-op :test-asdf/dll-user))) (assert-equal (test-package::sample-function) 42) - (operate 'monolithic-dll-op :test-asdf/monodll) - (si:load-foreign-module (first (output-files 'monolithic-dll-op :test-asdf/monodll))) - (operate 'load-op :test-asdf/monodll-user) + + (nest + #+(and mkcl windows) + (let* ((lib (first (output-files (operate 'lib-op :test-asdf/monodll-1) :test-asdf/monodll-1))) + (compiler::*builder-default-libraries* (list (namestring lib))))) + (operate 'monolithic-dll-op :test-asdf/monodll)) + + (let ((dll (first (output-files 'monolithic-dll-op :test-asdf/monodll)))) + (si:load-foreign-module dll) + (let* (#+(and mkcl windows) (compiler::*builder-default-libraries* (list (namestring dll)))) + (operate 'load-op :test-asdf/monodll-user))) (assert-equal (test-package::always-42) 42)) + +;;; TODO: test prebuilt-system. diff --git a/test/test-mutual-redefinition-1.asd b/test/test-mutual-redefinition-1.asd new file mode 100644 index 0000000000000000000000000000000000000000..1e74af0e0589bcdf1929cf9435ff1e503db0a54a --- /dev/null +++ b/test/test-mutual-redefinition-1.asd @@ -0,0 +1,2 @@ +(defsystem test-mutual-redefinition-1) +(defsystem test-mutual-redefinition-2) diff --git a/test/test-mutual-redefinition-2.asd b/test/test-mutual-redefinition-2.asd new file mode 100644 index 0000000000000000000000000000000000000000..1e74af0e0589bcdf1929cf9435ff1e503db0a54a --- /dev/null +++ b/test/test-mutual-redefinition-2.asd @@ -0,0 +1,2 @@ +(defsystem test-mutual-redefinition-1) +(defsystem test-mutual-redefinition-2) diff --git a/test/test-mutual-redefinition.script b/test/test-mutual-redefinition.script new file mode 100644 index 0000000000000000000000000000000000000000..4f66c4672449e6fbb969f02ecf9e7f3487f24ec6 --- /dev/null +++ b/test/test-mutual-redefinition.script @@ -0,0 +1,33 @@ +;;-*- Lisp -*- + +(load-system 'test-mutual-redefinition-1) +(defun current-system-source-file (x) + (system-source-file (cdr (gethash x asdf/find-system:*defined-systems*)))) + +(with-asdf-cache () + (DBG "loading test-mutual-redefinition-1") + (assert-pathname-equal + (test-source "test-mutual-redefinition-1.asd") + (current-system-source-file "test-mutual-redefinition-1")) + (assert-pathname-equal + (test-source "test-mutual-redefinition-1.asd") + (current-system-source-file "test-mutual-redefinition-2")) + + (DBG "loading test-mutual-redefinition-2 in the same cache session") + (load-system 'test-mutual-redefinition-2) + (assert-pathname-equal + (test-source "test-mutual-redefinition-1.asd") + (current-system-source-file "test-mutual-redefinition-1")) + (assert-pathname-equal + (test-source "test-mutual-redefinition-1.asd") + (current-system-source-file "test-mutual-redefinition-2")) + + (with-asdf-cache (:override t) + (DBG "loading test-mutual-redefinition-2 in a different cache session") + (load-system 'test-mutual-redefinition-2) + (assert-pathname-equal + (test-source "test-mutual-redefinition-2.asd") + (current-system-source-file "test-mutual-redefinition-1")) + (assert-pathname-equal + (test-source "test-mutual-redefinition-2.asd") + (current-system-source-file "test-mutual-redefinition-2")))) diff --git a/test/test-program.script b/test/test-program.script index 4d6ba6f0f623483cbcb40c08b8d36cfe8ad72421..994ca947d933bb9ecd31f3914fa61c278de66f70 100644 --- a/test/test-program.script +++ b/test/test-program.script @@ -1,17 +1,15 @@ ;;; -*- Lisp -*- - (DBG :foo (current-lisp-file-pathname)) -(unless (or #+(or clisp clozure (and ecl (not ecl-bytecmp)) lispworks sbcl) t - #+cmu nil ;; uncomment if you have 32-bit gcc support - or can autodetect - #+clisp (version-satisfies - (first (split-string (lisp-implementation-version) :separator " ")) - "2.48")) - (DBG "Creating standalone programs is not supported on your CL implementation") +(unless (or #+(or allegro clisp clozure cmu (and ecl (not ecl-bytecmp)) lispworks mkcl sbcl scl) t) + (DBG "Creating images is not supported on your CL implementation") (leave-test "Skipping test" 0)) -(defparameter exe (output-file (make-operation 'program-op) (find-system :hello-world-example))) -(assert (absolute-pathname-p exe)) +(assert (find-system :hello-world-example)) + +#+allegro +(defparameter *lisp* + (truename (subpathname #p"sys:" (first (raw-command-line-arguments))))) ;; Try to load lisp-invocation from xcvb (setf *central-registry* @@ -28,22 +26,85 @@ ;; Disable any user source registry. (initialize-source-registry `(:source-registry :ignore-inherited-configuration)) +(DBG "test image-op") +(defparameter img (output-file (make-operation 'image-op) (find-system :hello-world-example))) +(assert (absolute-pathname-p img)) +(delete-file-if-exists img) +(DBG "- first create an executable image") +(assert-equal + (nth-value 2 + (run-program + (symbol-call :lisp-invocation :lisp-invocation-arglist + #+allegro :lisp-path #+allegro *lisp* + :load (native-namestring (subpathname *test-directory* "make-hello-world.lisp")) + :eval "(asdf-test::make-hello-image)") + :output t :error-output :output :input nil)) + 0) +(assert (probe-file* img) () "Can't find image file ~S" img) + +(DBG "- then, use it") +(assert-equal + (nest + #+lispworks (last) + (run-program + (symbol-call :lisp-invocation :lisp-invocation-arglist + #+allegro :lisp-path #+allegro *lisp* + :image-path (native-namestring img) + :eval "(uiop:restore-image :entry-point 'hello:entry-point :lisp-interaction nil)") + :output :lines :error-output t)) + '("hello, world")) + +(DBG "- now, use it with arguments") +#-(or lispworks scl) ;; These can't be passed arguments the normal way +(assert-equal + (run-program + (symbol-call :lisp-invocation :lisp-invocation-arglist + #+allegro :lisp-path #+allegro *lisp* + :image-path (native-namestring img) + :eval "(uiop:restore-image :entry-point 'hello:entry-point :lisp-interaction nil)" + :arguments '("a" "b c" "d")) + :output :lines :error-output t) + '("hello, world" + "You passed 3 arguments:" + " \"a\"" + " \"b c\"" + " \"d\"")) + +(DBG "test program-op") +(unless (or #+(or clisp clozure (and ecl (not ecl-bytecmp)) lispworks mkcl sbcl) t + #+cmu nil ;; uncomment if you have 32-bit gcc support - or can autodetect + #+clisp (version-satisfies + (first (split-string (lisp-implementation-version) :separator " ")) + "2.48")) + (DBG "Creating standalone programs is not supported on your CL implementation") + (leave-test "Skipping test" 0)) + +(defparameter exe (output-file (make-operation 'program-op) (find-system :hello-world-example))) +(assert (absolute-pathname-p exe)) (delete-file-if-exists exe) +(DBG "- first, create the standalone program") (assert-equal (nth-value 2 (run-program (symbol-call :lisp-invocation :lisp-invocation-arglist - :load (native-namestring (subpathname *test-directory* "make-hello-world.lisp"))) + #+allegro :lisp-path #+allegro *lisp* + :load (native-namestring (subpathname *test-directory* "make-hello-world.lisp")) + :eval "(asdf-test::make-hello-program)") :output t :error-output :output :input nil)) 0) -(assert (probe-file* exe)) -(assert-equal (run-program `(,(native-namestring exe)) :output :lines) +(assert (probe-file* exe) () "Can't find executable file ~S" exe) + +(DBG "- use that") +(assert-equal (run-program `(,(native-namestring exe)) :output :lines :error-output t) '("hello, world")) -(assert-equal (run-program `(,(native-namestring exe) "a" "b c" "d") :output :lines) +(DBG "- use that with arguments") +(assert-equal (run-program `(,(native-namestring exe) "a" "b c" "d") :output :lines :error-output t) '("hello, world" "You passed 3 arguments:" " \"a\"" " \"b c\"" " \"d\"")) + +;;; TODO: include a regular system dependency and a prebuilt-system in the executable. diff --git a/test/test-retry-loading-component-1.script b/test/test-retry-loading-component-1.script index ee4486f7ffcd2f78a675b27126d6ff5d8b9a00dc..2097ce06e1bb84ca25dcc1e1176b69f16baeebf2 100644 --- a/test/test-retry-loading-component-1.script +++ b/test/test-retry-loading-component-1.script @@ -4,10 +4,11 @@ (defvar *caught-error* nil) (delete-file-if-exists "try-reloading-dependency.asd") -(asdf::clear-defined-systems) +(with-asdf-cache (:override t) (handler-bind ((error #'(lambda (c) (format t "~&Caught error ~s" c) + (assert (not *caught-error*) () "Déjà vu") (setf *caught-error* t) (concatenate-files '("try-reloading-dependency.hidden") "try-reloading-dependency.asd") (DBG "trlc1 5") @@ -17,4 +18,4 @@ (assert restart) (when restart (invoke-restart restart))))))) (load-system 'try-reloading-1)) -(assert *caught-error*) +(assert *caught-error*)) diff --git a/test/test-sysdef-asdf.script b/test/test-sysdef-asdf.script index 337acf81b7c4315c5a841ec2e109cb96410635ae..63cae2192bfcfa227dd8f06353cb71669ed8e6da 100644 --- a/test/test-sysdef-asdf.script +++ b/test/test-sysdef-asdf.script @@ -15,22 +15,25 @@ (declare (ignore system)) (subpathname *test-directory* "always-error.lisp")) +(asdf::clear-defined-system "asdf") (let ((*system-definition-search-functions* '(sysdef-bogus-test-search)) (state "Didn't catch warning")) (DBG "Bogus attempt at loading an old ASDF: should issue a warning and ignore") (handler-bind ((simple-warning - #'(lambda (c) - (when (search "ASDF will ignore this configured system rather than downgrade itself." - (simple-condition-format-control c)) - (setf state "Caught warning"))))) - (upgrade-asdf)) + #'(lambda (c) + (when (search "ASDF will ignore this configured system rather than downgrade itself." + (simple-condition-format-control c)) + (setf state "Caught warning"))))) + (asdf::clear-defined-system "asdf") + (upgrade-asdf)) (assert-equal state "Caught warning") (DBG "2nd bogus attempt at loading same old ASDF: should ignore without a warning") (handler-bind ((simple-warning - #'(lambda (c) - (error "Should not have issued warning, but did issue:~% ~A" c)))) + #'(lambda (c) + (error "Should not have issued warning, but did issue:~% ~A" c)))) + (asdf::clear-defined-system "asdf") (upgrade-asdf))) (DBG "Load ASDF with proper configuration: should find asdf.asd from the source above") @@ -39,14 +42,18 @@ (:directory ,*asdf-directory*) (:directory ,*uiop-directory*) :ignore-inherited-configuration)) +(asdf::clear-defined-system "asdf") (load-system :asdf) ;; This time we found it, but it was skipped because the version was the same (assert-equal nil (system-source-file (find-system :asdf))) + ;; But if we cheat on our version, that should work (setf asdf::*asdf-version* "3.0") +(asdf::clear-defined-system "asdf") +#-xcl ;; XCL has trouble with the ASDF upgrade (load-system :asdf) (assert-pathname-equal (subpathname *asdf-directory* "asdf.asd") - (system-source-file (find-system :asdf))) + (system-source-file (find-system :asdf))) (DBG "Checking that Makefile and asdf.asd are in synch") (defun system-lisp-files (system) diff --git a/test/test-touch-system-1.script b/test/test-touch-system-1.script index f648080ad75f8a87eb92ea6bdf4d4e856683c3ca..a8b1e72d09679bb510241d8f3e8f855ae573ae07 100644 --- a/test/test-touch-system-1.script +++ b/test/test-touch-system-1.script @@ -2,9 +2,9 @@ ;;; test system def reloading if touched ;;; system that can be found using *system-definition-search-functions* - (defun system-registered-time (name) (car (asdf::system-registered-p name))) + (defparameter test1.asd (nth-value 2 (locate-system :test1))) (assert-pathname-equal test1.asd (test-source "test1.asd")) (defparameter file1.lisp (test-source "file1.lisp")) @@ -14,11 +14,13 @@ (defparameter date1 (get-file-stamp test1.asd)) (defparameter date2 (- date1 600)) (defparameter date3 (- date1 300)) + +(asdf::clear-defined-system :test1) (touch-file test1.asd :timestamp date2) (touch-file file1.lisp :timestamp date3) (touch-file file2.lisp :timestamp date3) (assert-equal nil (system-registered-time :test1)) -(find-system :test1) +(load-system :test1) (defparameter date4 (get-file-stamp file2.fasl)) (defparameter date5 (system-registered-time :test1)) (DBG :blah date1 date2 date3 date4 date5) @@ -26,6 +28,8 @@ (assert-equal date2 date5) (assert-compare (>= date4 date3)) (sleep 1) + +(asdf::clear-defined-system :test1) (touch-file test1.asd) (find-system :test1) (defparameter date6 (system-registered-time :test1)) diff --git a/test/test-touch-system-2.script b/test/test-touch-system-2.script index b13593973304cae2889f714443202e7d4491e78a..7cc05e4060d071cff31e102126435b77eab308e1 100644 --- a/test/test-touch-system-2.script +++ b/test/test-touch-system-2.script @@ -10,12 +10,16 @@ (assert-pathname-equal test1.asd (test-source "test1.asd")) (assert test1.asd) +(asdf::clear-defined-systems) (setf asdf:*central-registry* nil) (load test1.asd) (assert (find-system :test1)) (defparameter date1 (system-registered-time :test1)) (assert date1) + +(asdf::clear-defined-systems) (touch-file test1.asd :timestamp date1 :offset +2) +(load test1.asd) (find-system :test1) (defparameter date2 (system-registered-time :test1)) (assert date2) diff --git a/test/test1.asd b/test/test1.asd index 862f2ad4cbc95dd31b1d1dfcf61aadc486cd9512..b699e64464e0bc4879292f465bd7122abfd5a707 100644 --- a/test/test1.asd +++ b/test/test1.asd @@ -1,5 +1,5 @@ ;;; -*- Lisp -*- -(asdf:defsystem test1 +(defsystem test1 :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")) (load-op (load-op "file1")))) (:file "file1"))) diff --git a/uiop/common-lisp.lisp b/uiop/common-lisp.lisp index aa2e4efad4a3e22a3ddfd27bc56f8eeaf265618e..4e156063b5947c1bccb888b86d87549a28b47322 100644 --- a/uiop/common-lisp.lisp +++ b/uiop/common-lisp.lisp @@ -30,7 +30,7 @@ ;;;; Early meta-level tweaks -#+(or abcl allegro clisp cmu ecl mkcl clozure lispworks sbcl scl) +#+(or abcl allegro clisp cmu ecl mkcl clozure lispworks mkcl sbcl scl) (eval-when (:load-toplevel :compile-toplevel :execute) ;; Check for unicode at runtime, so that a hypothetical FASL compiled with unicode ;; but loaded in a non-unicode setting (e.g. on Allegro) won't tell a lie. diff --git a/uiop/driver.lisp b/uiop/driver.lisp index 4d342d2ad2d7a0fc5c67581a2124b38b0f30499e..f36e02df060d0a1466a309ff82ef350b08da53fc 100644 --- a/uiop/driver.lisp +++ b/uiop/driver.lisp @@ -13,3 +13,5 @@ :uiop/os :uiop/pathname :uiop/stream :uiop/filesystem :uiop/image :uiop/run-program :uiop/lisp-build :uiop/configuration :uiop/backward-driver)) + +#+mkcl (provide :uiop) diff --git a/uiop/filesystem.lisp b/uiop/filesystem.lisp index f42c3f6de9cbec5004cf0b32617c2ea428df0e8e..392bb3956d512d1d8ba8896f504467f639dc70a9 100644 --- a/uiop/filesystem.lisp +++ b/uiop/filesystem.lisp @@ -598,7 +598,7 @@ in an atomic way if the implementation allows." `(,dd directory-pathname) ;; requires SBCL 1.0.44 or later `(progn (require :sb-posix) (symbol-call :sb-posix :rmdir directory-pathname))) #+xcl (symbol-call :uiop :run-program `("rmdir" ,(native-namestring directory-pathname))) - #-(or abcl allegro clisp clozure cmu cormanlisp digitool ecl gcl lispworks sbcl scl xcl) + #-(or abcl allegro clisp clozure cmu cormanlisp digitool ecl gcl lispworks mkcl sbcl scl xcl) (error "~S not implemented on ~S" 'delete-empty-directory (implementation-type))) ; genera (defun delete-directory-tree (directory-pathname &key (validate nil validatep) (if-does-not-exist :error)) diff --git a/uiop/image.lisp b/uiop/image.lisp index 47bb43b9406f660d2a409c5db0397a0e3a182ac3..39a7066ef0362acf1273b36140b2d36041bdab04 100644 --- a/uiop/image.lisp +++ b/uiop/image.lisp @@ -118,7 +118,7 @@ This is designed to abstract away the implementation specific quit forms." (let ((debug:*debug-print-level* *print-level*) (debug:*debug-print-length* *print-length*)) (debug:backtrace (or count most-positive-fixnum) stream)) - #+ecl + #+(or ecl mkcl) (let* ((top (si:ihs-top)) (repeats (if count (min top count) top)) (backtrace (loop :for ihs :from 0 :below top @@ -233,9 +233,10 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die" #+gcl si:*command-args* #+(or genera mcl) 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 clisp clozure cmu ecl gcl genera lispworks mcl sbcl scl xcl) + #-(or abcl allegro clisp clozure cmu ecl gcl genera lispworks mcl mkcl sbcl scl xcl) (error "raw-command-line-arguments not implemented yet")) (defun command-line-arguments (&optional (arguments (raw-command-line-arguments))) @@ -263,10 +264,10 @@ return a string that for the name with which the program was invoked, i.e. argv[ Otherwise, return NIL." (cond ((eq *image-dumped-p* :executable) ; yes, this ARGV0 is our argv0 ! - ;; NB: not currently available on ABCL, Corman, Genera, MCL, MKCL + ;; NB: not currently available on ABCL, Corman, Genera, MCL (or #+(or allegro clisp clozure cmu gcl lispworks sbcl scl xcl) (first (raw-command-line-arguments)) - #+ecl (si:argv 0))) + #+ecl (si:argv 0) #+mkcl (mkcl:argv 0))) (t ;; argv[0] is the name of the interpreter. ;; The wrapper script can export __CL_ARGV0. cl-launch does as of 4.0.1.8. (getenvp "__CL_ARGV0")))) @@ -437,8 +438,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows." ((:image) (setf kind :program) ;; to ECL, it's just another program. `((setf *image-dumped-p* t) - ;; fall through should be equivalent to: (si::top-level t) (quit) - )) + (si::top-level t) (quit))) ((:program) `((setf *image-dumped-p* :executable) (shell-boolean-exit diff --git a/uiop/lisp-build.lisp b/uiop/lisp-build.lisp index b42165d3190f75c7b860f05116218680198ad13a..adab079bace012c440eea6d9f09abbd12c498078 100644 --- a/uiop/lisp-build.lisp +++ b/uiop/lisp-build.lisp @@ -62,16 +62,17 @@ This can help you produce more deterministic output for FASLs.")) "Optimization settings saved by PROCLAIM-OPTIMIZATION-SETTINGS") (defun get-optimization-settings () "Get current compiler optimization settings, ready to PROCLAIM again" - #-(or clisp clozure cmu ecl sbcl scl) + #-(or clisp clozure cmu ecl mkcl sbcl scl) (warn "~S does not support ~S. Please help me fix that." 'get-optimization-settings (implementation-type)) #+clozure (ccl:declaration-information 'optimize nil) - #+(or clisp cmu ecl sbcl scl) + #+(or clisp cmu ecl mkcl sbcl scl) (let ((settings '(speed space safety debug compilation-speed #+(or cmu scl) c::brevity))) #.`(loop :for x :in settings ,@(or #+ecl '(:for v :in '(c::*speed* c::*space* c::*safety* c::*debug*)) + #+mkcl '(:for v :in '(si::*speed* si::*space* si::*safety* si::*debug*)) #+(or cmu scl) '(:for f :in '(c::cookie-speed c::cookie-space c::cookie-safety c::cookie-debug c::cookie-cspeed c::cookie-brevity))) :for y = (or #+clisp (gethash x system::*optimize*) - #+(or ecl) (symbol-value v) + #+(or ecl mkcl) (symbol-value v) #+(or cmu scl) (funcall f c::*default-cookie*) #+sbcl (cdr (assoc x sb-c::*policy*))) :when y :collect (list x y)))) diff --git a/uiop/os.lisp b/uiop/os.lisp index 6d7afebe520813a1b178139f2debb8205e87e7dd..2f26bc8187c35fd0e92231cb9e4432c4824fd199 100644 --- a/uiop/os.lisp +++ b/uiop/os.lisp @@ -49,7 +49,7 @@ keywords explicitly." (defun os-windows-p () "Is the underlying operating system Microsoft Windows?" (or #+abcl (featurep :windows) - #+(and (not (or abcl unix cygwin darwin)) (or win32 windows mswindows mingw32)) t)) + #+(and (not (or abcl unix cygwin darwin)) (or win32 windows mswindows mingw32 mingw64)) t)) (defun os-genera-p () "Is the underlying operating system Genera (running on a Symbolics Lisp Machine)?" diff --git a/uiop/pathname.lisp b/uiop/pathname.lisp index edd157717e73ee2e686752ebf7539c346db18982..8bb82ac8a99441708d0eebeb4d4f8d6120eab920 100644 --- a/uiop/pathname.lisp +++ b/uiop/pathname.lisp @@ -91,8 +91,8 @@ by the underlying implementation's MAKE-PATHNAME and other primitives" ;; See CLHS make-pathname and 19.2.2.2.3. ;; This will be :unspecific if supported, or NIL if not. (defparameter *unspecific-pathname-type* - #+(or abcl allegro clozure cmu genera lispworks mkcl sbcl scl) :unspecific - #+(or clisp ecl gcl xcl #|These haven't been tested:|# cormanlisp mcl) nil + #+(or abcl allegro clozure cmu genera lispworks sbcl scl) :unspecific + #+(or clisp ecl mkcl gcl xcl #|These haven't been tested:|# cormanlisp mcl) nil "Unspecific type component to use with the underlying implementation's MAKE-PATHNAME") (defun make-pathname* (&rest keys &key (directory nil) @@ -190,8 +190,9 @@ when merging, making or parsing pathnames" ;; But CMUCL decides to die on NIL. ;; MCL has issues with make-pathname, nil and defaulting (declare (ignorable defaults)) - #.`(make-pathname* :directory nil :name nil :type nil :version nil :device nil - :host (or #+cmu lisp::*unix-host*) + #.`(make-pathname* :directory nil :name nil :type nil :version nil + :device (or #+(and mkcl unix) :unspecific) + :host (or #+cmu lisp::*unix-host* #+(and mkcl unix) "localhost") #+scl ,@'(:scheme nil :scheme-specific-part nil :username nil :password nil :parameters nil :query nil :fragment nil) ;; the default shouldn't matter, but we really want something physical @@ -224,11 +225,11 @@ when merging, making or parsing pathnames" (or (and (null p1) (null p2)) (and (pathnamep p1) (pathnamep p2) (and (=? pathname-host) - (=? pathname-device) + #-(and mkcl unix) (=? pathname-device) (=? normalize-pathname-directory-component pathname-directory) (=? pathname-name) (=? pathname-type) - (=? pathname-version))))))) + #-mkcl (=? pathname-version))))))) (defun absolute-pathname-p (pathspec) "If PATHSPEC is a pathname or namestring object that parses as a pathname diff --git a/uiop/run-program.lisp b/uiop/run-program.lisp index 0863b1d9ee4335367d5f10e9c39fdabea5bf757b..bae693bf8044d93baf9093c55b85fdf17279b3cc 100644 --- a/uiop/run-program.lisp +++ b/uiop/run-program.lisp @@ -341,6 +341,7 @@ for the implementation's underlying run-program function" #+os-unix (list command) #+os-windows (string + #+mkcl (list "cmd" '#:/c command) ;; NB: We do NOT add cmd /c here. You might want to. #+(or allegro clisp) command ;; On ClozureCL for Windows, we assume you are using @@ -350,7 +351,7 @@ for the implementation's underlying run-program function" ;; NB: On other Windows implementations, this is utterly bogus ;; except in the most trivial cases where no quoting is needed. ;; Use at your own risk. - #-(or allegro clisp clozure) (list "cmd" "/c" command)) + #-(or allegro clisp clozure mkcl) (list "cmd" "/c" command)) #+os-windows (list #+allegro (escape-windows-command command) @@ -377,8 +378,8 @@ argument to pass to the internal RUN-PROGRAM" ((eql :interactive) #+allegro nil #+clisp :terminal - #+(or clozure cmu ecl sbcl scl) t) - #+(or allegro clozure cmu ecl lispworks sbcl scl) + #+(or clozure cmu ecl mkcl sbcl scl) t) + #+(or allegro clozure cmu ecl lispworks mkcl sbcl scl) ((eql :output) (if (eq role :error-output) :output @@ -409,12 +410,12 @@ to be normalized by %NORMALIZE-IO-SPECIFIER. It returns a process-info plist with possible keys: PROCESS, EXIT-CODE, INPUT-STREAM, OUTPUT-STREAM, BIDIR-STREAM, ERROR-STREAM." ;; NB: these implementations have unix vs windows set at compile-time. - (declare (ignorable if-input-does-not-exist if-output-exists if-error-output-exists)) + (declare (ignorable directory if-input-does-not-exist if-output-exists if-error-output-exists)) (assert (not (and wait (member :stream (list input output error-output))))) - #-(or allegro clisp clozure cmu (and lispworks os-unix) sbcl scl) + #-(or allegro clisp clozure cmu (and lispworks os-unix) mkcl sbcl scl) (progn command keys directory (error "run-program not available")) - #+(or allegro clisp clozure cmu (and lispworks os-unix) sbcl scl) + #+(or allegro clisp clozure cmu (and lispworks os-unix) mkcl sbcl scl) (let* ((%command (%normalize-command command)) (%input (%normalize-io-specifier input :input)) (%output (%normalize-io-specifier output :output)) @@ -434,7 +435,7 @@ It returns a process-info plist with possible keys: #+os-windows :show-window #+os-windows (if interactive nil :hide) :allow-other-keys t keys)) #-allegro - (with-current-directory (#-sbcl directory) + (with-current-directory (#-(or sbcl mkcl) directory) #+clisp (flet ((run (f x &rest args) (multiple-value-list @@ -446,11 +447,11 @@ It returns a process-info plist with possible keys: #+os-windows (string (run 'ext:run-shell-command %command)) (list (run 'ext:run-program (car %command) :arguments (cdr %command))))) - #+(or clozure cmu ecl sbcl scl) - (#-ecl progn #+ecl multiple-value-list + #+(or clozure cmu ecl mkcl sbcl scl) + (#-(or ecl mkcl) progn #+(or ecl mkcl) multiple-value-list (apply '#+(or cmu ecl scl) ext:run-program - #+clozure ccl:run-program #+sbcl sb-ext:run-program + #+clozure ccl:run-program #+sbcl sb-ext:run-program #+mkcl mk-ext:run-program (car %command) (cdr %command) :input %input :output %output @@ -458,7 +459,7 @@ It returns a process-info plist with possible keys: :wait wait :allow-other-keys t (append - #+(or clozure cmu sbcl scl) + #+(or clozure cmu mkcl sbcl scl) `(:if-input-does-not-exist ,if-input-does-not-exist :if-output-exists ,if-output-exists :if-error-exists ,if-error-output-exists) @@ -525,8 +526,8 @@ It returns a process-info plist with possible keys: #+clozure (ccl:external-process-error-stream process*) #+(or cmu scl) (ext:process-error process*) #+sbcl (sb-ext:process-error process*)))) - #+ecl - (destructuring-bind (stream code process) process* + #+(or ecl mkcl) + (destructuring-bind #+ecl (stream code process) #+mkcl (stream process code) process* (let ((mode (+ (if (eq input :stream) 1 0) (if (eq output :stream) 2 0)))) (cond ((zerop mode)) @@ -553,8 +554,9 @@ It returns a process-info plist with possible keys: #+clozure (ccl::external-process-pid process) #+ecl (si:external-process-pid process) #+(or cmu scl) (ext:process-pid process) + #+mkcl (mkcl:process-id process) #+sbcl (sb-ext:process-pid process) - #-(or allegro cmu sbcl scl) (error "~S not implemented" '%process-info-pid))) + #-(or allegro cmu mkcl sbcl scl) (error "~S not implemented" '%process-info-pid))) (defun %wait-process-result (process-info) (or (getf process-info :exit-code) @@ -578,7 +580,8 @@ It returns a process-info plist with possible keys: (system:pipe-exit-status stream :wait t) (if-let ((f (find-symbol* :pid-exit-status :system nil))) (funcall f process :wait t))) - #+sbcl (sb-ext:process-exit-code process))))) + #+sbcl (sb-ext:process-exit-code process) + #+mkcl (mkcl:join-process process))))) (defun %check-result (exit-code &key command process ignore-error-status) (unless ignore-error-status @@ -678,7 +681,7 @@ It returns a process-info plist with possible keys: (defun %use-run-program (command &rest keys &key input output error-output ignore-error-status &allow-other-keys) ;; helper for RUN-PROGRAM when using %run-program - #+(or abcl cormanlisp gcl (and lispworks os-windows) mcl mkcl xcl) + #+(or abcl cormanlisp gcl (and lispworks os-windows) mcl xcl) (progn command keys input output error-output ignore-error-status ;; ignore (error "Not implemented on this platform")) @@ -788,11 +791,7 @@ It returns a process-info plist with possible keys: (ext:system %command)) #+gcl (system:system %command) #+mcl (ccl::with-cstrs ((%%command %command)) (_system %%command)) - #+mkcl ;; PROBABLY BOGUS -- ask jcb - (multiple-value-bind (io process exit-code) - (mkcl:run-program #+windows %command #+windows () - #-windows "/bin/sh" #-windows (list "-c" %command) - :input t :output t)) + #+mkcl (mkcl:system %command) #+xcl (system:%run-shell-command %command)))) (defun %use-system (command &rest keys @@ -871,7 +870,7 @@ RUN-PROGRAM returns 3 values: 2- either 0 if the subprocess exited with success status, or an indication of failure via the EXIT-CODE of the process" (declare (ignorable ignore-error-status)) - #-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl lispworks mcl sbcl scl xcl) + #-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl lispworks mcl mkcl sbcl scl xcl) (error "RUN-PROGRAM not implemented for this Lisp") (flet ((default (x xp output) (cond (xp x) ((eq output :interactive) :interactive)))) (apply (if (or force-shell @@ -879,7 +878,7 @@ or an indication of failure via the EXIT-CODE of the process" #+clisp (eq error-output :interactive) #+(or abcl clisp) (eq :error-output :output) #+(and lispworks os-unix) (%interactivep input output error-output) - #+(or abcl cormanlisp gcl (and lispworks os-windows) mcl mkcl xcl) t) + #+(or abcl cormanlisp gcl (and lispworks os-windows) mcl xcl) t) '%use-system '%use-run-program) command :input (default input inputp output) diff --git a/uiop/stream.lisp b/uiop/stream.lisp index 464e933e678cd8c4253171beb22b0d20bc07013d..1590b71c4cc3927544e50b65c807bd336d597468 100644 --- a/uiop/stream.lisp +++ b/uiop/stream.lisp @@ -645,7 +645,7 @@ Upon success, the KEEP form is evaluated and the file is is deleted unless it ev ,@(when directory `(:directory ,directory)) ,@(when prefix `(:prefix ,prefix)) ,@(when suffix `(:suffix ,suffix)) - ,@(when type `(:suffix ,type)) + ,@(when type `(:type ,type)) ,@(when keep `(:keep ,keep)) ,@(when after `(:after `#',afterf)) ,@(when element-type `(:element-type ,element-type)) diff --git a/uiop/utility.lisp b/uiop/utility.lisp index c8fa3878eb2e06c429764fcd20235829d764e42d..1d362da66806ce3e21c22d7ea3823bc7f96e093a 100644 --- a/uiop/utility.lisp +++ b/uiop/utility.lisp @@ -546,10 +546,10 @@ with later being determined by a lexicographical comparison of minor numbers." #+clisp 'system::$format-control #+clozure 'ccl::format-control #+(or cmu scl) 'conditions::format-control - #+ecl 'si::format-control + #+(or ecl mkcl) 'si::format-control #+(or gcl lispworks) 'conditions::format-string #+sbcl 'sb-kernel:format-control - #-(or abcl allegro clisp clozure cmu ecl gcl lispworks sbcl scl) nil + #-(or abcl allegro clisp clozure cmu ecl gcl lispworks mkcl sbcl scl) nil "Name of the slot for FORMAT-CONTROL in simple-condition") (defun match-condition-p (x condition) diff --git a/upgrade.lisp b/upgrade.lisp index 47231fc5d6ef2cfb99086d0d95bed371a7ba5c46..f8f14ae4b759e1174f54bb7a607c1e1cb01357df 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -34,15 +34,6 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO (defvar *asdf-version* nil) ;; We need to clear systems from versions yet older than the below: (defparameter *oldest-forward-compatible-asdf-version* "2.33") ;; 2.32.13 renames a slot in component. - (defmacro defparameter* (var value &optional docstring) - (let* ((name (string-trim "*" var)) - (valfun (intern (format nil "%~A-~A-~A" :compute name :value))) - (clearfun (intern (format nil "%~A-~A" :clear name)))) - `(progn - (defun ,valfun () ,value) - (defvar ,var (,valfun) ,@(ensure-list docstring)) - (defun ,clearfun () (setf ,var (,valfun))) - (register-hook-function '*post-upgrade-cleanup-hook* ',clearfun)))) (defvar *verbose-out* nil) (defun asdf-message (format-string &rest format-args) (when *verbose-out* (apply 'format *verbose-out* format-string format-args))) @@ -51,6 +42,14 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO (defun upgrading-p (&optional (oldest-compatible-version *oldest-forward-compatible-asdf-version*)) (and *previous-asdf-versions* (version< (first *previous-asdf-versions*) oldest-compatible-version))) + (defmacro defparameter* (var value &optional docstring (version *oldest-forward-compatible-asdf-version*)) + (let* ((name (string-trim "*" var)) + (valfun (intern (format nil "%~A-~A-~A" :compute name :value)))) + `(progn + (defun ,valfun () ,value) + (defvar ,var (,valfun) ,@(ensure-list docstring)) + (when (upgrading-p ,version) + (setf ,var (,valfun)))))) (defmacro when-upgrading ((&key (version *oldest-forward-compatible-asdf-version*) (upgrading-p `(upgrading-p ,version)) when) &body body) "A wrapper macro for code that should only be run when upgrading a @@ -68,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.0.94") + (asdf-version "3.1.0.102") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) diff --git a/version.lisp-expr b/version.lisp-expr index e39bd9898be5c7cdf82960803fe265836e766798..49eea6dc099234a0afecbfc99230b9d29c3bf39f 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1,2 +1,2 @@ -"3.1.0.94" +"3.1.0.102"