diff --git a/asdf.asd b/asdf.asd index e31bd154c79b213e6c6adca855deedabc8a7f42b..602ac09b9fc114631f9094cff812fbcb5d6a1bba 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.4.15" ;; to be automatically updated by make bump-version + :version "3.1.4.17" ;; to be automatically updated by make bump-version :depends-on () #+asdf3 :encoding #+asdf3 :utf-8 :class #+asdf3.1 package-inferred-system #-asdf3.1 system diff --git a/debian/changelog b/debian/changelog index 0ce7ea7e6b014c0ee34d6053e47cc1fbfa2cae7d..aa32bd006a0818947dfc6d7f8358e68621db8ede 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,18 +1,23 @@ cl-asdf (2:3.1.5-1) unstable; urgency=low - Bug fix release: + Bug fix and portability release: + * Add immutable-system support (thanks to Dave Cooper). * Add CLASP support. * Many miscellaneous fixes for issues on individual implementations, - notably UIOP incompatibility introduced by SBCL 1.2.12 (closes: #787909). + notably UIOP incompatibility introduced by SBCL 1.2.12, support for + LispWorks 7 character types, fixes to chdir on ABCL, improvements + to run-program on Windows. * Added OS-COND to UIOP to paper over some incompatibilities about when and how operating system can be detected on different implementations. + Made OS predicates run test at runtime so you can bind *features* from + a target system and determine its OS. * Fixes to XDG configuration directory handling. Try to stick to the XDG spec, rather than guessing what it should be on different platforms. To recognize this, change UIOP functions about XDG files to "XDG-" prefixes. * Documentation improvements. - -- François-René Rideau <fare@tunes.org> Sat, 06 Jun 2015 16:16:41 -0400 + -- François-René Rideau <fare@tunes.org> Tue, 09 Jun 2015 12:09:50 -0400 cl-asdf (2:3.1.4-1) unstable; urgency=low diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index b845d75197387a030deed96cd98118a029e34102..90ffd2a56815f0d83b9e7393714b5ec39e662168 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -136,7 +136,7 @@ Configuring ASDF Using ASDF * Loading a system:: -* Other Operations:: +* Convenience Functions:: * Moving on:: Defining systems with defsystem @@ -935,11 +935,11 @@ on CMUCL and SCL, etc. @menu * Loading a system:: -* Other Operations:: +* Convenience Functions:: * Moving on:: @end menu -@node Loading a system, Other Operations, Using ASDF, Using ASDF +@node Loading a system, Convenience Functions, Using ASDF, Using ASDF @section Loading a system The system @var{foo} is loaded (and compiled, if necessary) @@ -958,17 +958,16 @@ and you can just use: (require :@var{foo}) @end example -In older versions of ASDF, you needed to use +In old versions of ASDF 1, you needed to use @code{(asdf:oos 'asdf:load-op :@var{foo})}. If your ASDF is too old to provide @code{asdf:load-system} though -we recommend that you upgrade to ASDF 3. +we recommend that you upgrade to the latest ASDF 3 release. @xref{Loading ASDF,,Loading ASDF from source}. -Note the name of a system is specified as a string or a symbol. -If a symbol (including a keyword), its name is taken and lowercased. +Note that the name of a system is specified as a string or a symbol. +If it is a symbol (including a keyword), its @code{symbol-name} is taken and lowercased. The name must be a suitable value for the @code{:name} initarg -to @code{make-pathname} in whatever filesystem the system is to be -found. +to @code{make-pathname} in whatever filesystem the system is to be found. The lower-casing-symbols behaviour is unconventional, but was selected after some consideration. @@ -978,13 +977,13 @@ or silently convert lowercase to uppercase (lpns). @c so this makes more sense than attempting to use @code{:case :common}, @c which is reported not to work on some implementations -@node Other Operations, Moving on, Loading a system, Using ASDF -@section Other Operations +@node Convenience Functions, Moving on, Loading a system, Using ASDF +@section Convenience Functions @findex load-system @findex compile-system @findex test-system -@findex requrie-system +@findex require-system ASDF provides three commands for the most common system operations: @code{load-system}, @code{compile-system}, and @code{test-system}. @@ -1016,20 +1015,29 @@ should redirect all output from ASDF operations. @c FIXME: the following is too complicated for here, especially since @c :force hasn't been defined yet. Move it. [2014/02/27:rpg] -@findex already-loaded-systems -@findex require-system @findex load-system @vindex *load-system-operation* -For advanced users, note that -@code{require-system} calls @code{load-system} -with keyword arguments @code{:force-not (already-loaded-systems)}. -@code{already-loaded-systems} returns a list of the names of loaded systems. +@findex already-loaded-systems +@findex require-system @code{load-system} applies @code{operate} with the operation from -@code{*load-system-operation*} (which by default is @code{load-op}), +@code{*load-system-operation*} the system, and any provided keyword arguments. - - -@node Moving on, , Other Operations, Using ASDF +@code{*load-system-operation*} by default is @code{load-op}; +it would be @code{load-bundle-op} by default on ECL, if only an implementation bug were fixed. +For advanced users, note that +@code{already-loaded-systems} returns a list of the names of loaded systems. +@code{require-system} skips any update to systems that have already been loaded, +in the spirit of @code{cl:require}, +by calling @code{load-system} with @code{:force-not (already-loaded-systems)} +(note however that @code{cl:require} deals with implementation-provided modules +that are unlikely to have been compatibly updated since the current image was started, +whereas ASDF in general deals with user-provided systems at least one of which +is typically modified during a development session; +hence it doesn't usually make sense to check for updates to modules, +whereas it does usually make sense to check for updates to systems). + + +@node Moving on, , Convenience Functions, Using ASDF @section Moving on That's all you need to know to use ASDF to load systems written by others. @@ -1541,6 +1549,11 @@ where significant API incompatibilities are signaled by an increased major numbe Use the implementation's own @code{require} to load the @var{module-name}. +It is good taste to use @code{:if-feature @emph{:implementation-name}} +rather than @code{#+@emph{implementation-name}} +to only depend on the specified module on the specific implementation that provides it. +@xref{if-feature-option}. + @subsection Using logical pathnames @cindex logical pathnames @@ -1579,7 +1592,7 @@ ASDF currently provides no specific support for defining logical pathname translations. Note that the reasons we do not recommend logical pathnames are that -(1) there is no portable way to set up logical pathnames before they are used, +(1) there is no portable way to set up logical pathnames @emph{before} they are used, (2) logical pathnames are limited to only portably use a single character case, digits and hyphens. While you can solve the first issue on your own, diff --git a/doc/release-emails/asdf-3.1.2.txt b/doc/release-emails/asdf-3.1.2.txt new file mode 100644 index 0000000000000000000000000000000000000000..654221fe54ebe2166324cc71a95eac21bab3de47 --- /dev/null +++ b/doc/release-emails/asdf-3.1.2.txt @@ -0,0 +1,9 @@ +Today I have released (with much help from Fare) ASDF 3.1.3. + +We urge implementations that are currently shipping with 3.1.2 to move +forward to 3.1.3. 3.1.3 has no API incompatibilities that we know of, +and contains significant bug fixes. Most significantly, 3.1.3 fixes +bugs that impede hot-upgrade from 3.1.2 to a later version of ASDF, +which is critical to ASDF development. In addition, we have fixed +multiple bugs in ASDF system search caching, that impeded correct use of +restarts involving adding new systems to a running CL. diff --git a/doc/release-emails/asdf-3.1.5.txt b/doc/release-emails/asdf-3.1.5.txt new file mode 100644 index 0000000000000000000000000000000000000000..f955d98be140b3b252d5b02dc6b08c5e477ad37c --- /dev/null +++ b/doc/release-emails/asdf-3.1.5.txt @@ -0,0 +1,7 @@ +FIXME: Attach the changelog!!!! + +Today I have released ASDF 3.1.5. As usual many thanks are due to Faré for many bug fixes, clean ups, explanations, etc. Thanks are also owed to Dave Cooper, for testing on the Windows platform, and identifying many uncaught bugs. + +We urge implementations that are currently bundling previous versions of ASDF to adopt 3.1.5. 3.1.5 does not introduce any API incompatibilities that we know of, and contains significant bug fixes on multiple platforms and implementations. See the Changelog (attached) for a list of the major bug fixes. Details on minor bugfixes can be found at launchpad.net/asdf + +We hope that 3.1.5 will be the last 3.1.x release. We will now move to developing ASDF 3.2, which we expect will add new features. diff --git a/find-system.lisp b/find-system.lisp index 469affc8c0a193bdecc25ee41b49fe32caebd169..1621dc9e7425f575abf5e123856c1b47fcb10de6 100644 --- a/find-system.lisp +++ b/find-system.lisp @@ -18,8 +18,7 @@ #: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-system #:clear-defined-systems #:*defined-systems* - #:*immutable-systems* + #:*defined-systems* #:clear-defined-systems #:*immutable-systems* #:register-immutable-system ;; defined in source-registry, but specially mentioned here: #:initialize-source-registry #:sysdef-source-registry-search)) (in-package :asdf/find-system) @@ -89,29 +88,84 @@ of which is a system object.") (get-file-stamp file)) system))))) - (defun clear-defined-system (system) + (defvar *preloaded-systems* (make-hash-table :test 'equal)) + + (defun make-preloaded-system (name keys) + (apply 'make-instance (getf keys :class 'system) + :name name :source-file (getf keys :source-file) + (remove-plist-keys '(:class :name :source-file) keys))) + + (defun sysdef-preloaded-system-search (requested) + (let ((name (coerce-name requested))) + (multiple-value-bind (keys foundp) (gethash name *preloaded-systems*) + (when foundp + (make-preloaded-system name keys))))) + + (defun register-preloaded-system (system-name &rest keys) + (setf (gethash (coerce-name system-name) *preloaded-systems*) keys)) + + (dolist (s '("asdf" "uiop" "asdf-driver" "asdf-defsystem" "asdf-package-system")) + ;; don't bother with these, no one relies on them: "asdf-utils" "asdf-bundle" + (register-preloaded-system s :version *asdf-version*)) + + (defvar *immutable-systems* nil + "An hash-set (equal hash-table mapping keys to T) of systems that are immutable, +i.e. already loaded in memory and not to be refreshed from the filesystem. +They will be treated specially by find-system, and passed as :force-not argument to make-plan. + +If you deliver an image with many systems precompiled, *and* do not want to check the filesystem +for them every time a user loads an extension, what more risk a problematic upgrade or catastrophic +downgrade, before you dump an image, use: + (setf asdf::*immutable-systems* (uiop:list-to-hash-set (asdf:already-loaded-systems)))") + + (defun sysdef-immutable-system-search (requested) + (let ((name (coerce-name requested))) + (when (and *immutable-systems* (gethash name *immutable-systems*)) + (or (cdr (system-registered-p requested)) + (sysdef-preloaded-system-search name) + (error 'formatted-system-definition-error + :format-control "Requested system ~A is in the *immutable-systems* set, ~ +but not loaded in memory" + :format-arguments (list name)))))) + + (defun register-immutable-system (system-name &key (version t)) + (let* ((system-name (coerce-name system-name)) + (registered-system (cdr (system-registered-p system-name))) + (default-version? (eql version t)) + (version (cond ((and default-version? registered-system) + (component-version registered-system)) + (default-version? nil) + (t version)))) + (unless registered-system + (register-system (make-preloaded-system system-name (list :version version)))) + (register-preloaded-system system-name :version version) + (unless *immutable-systems* + (setf *immutable-systems* (list-to-hash-set nil))) + (setf (gethash (coerce-name system-name) *immutable-systems*) t))) + + (defun clear-system (system) + "Clear the entry for a SYSTEM in the database of systems previously loaded, +unless the system appears in the table of *IMMUTABLE-SYSTEMS*. +Note that this does NOT in any way cause the code of the system to be unloaded. +Returns T if cleared or already cleared, +NIL if not cleared because the system was found to be immutable." + ;; There is no "unload" operation in Common Lisp, and + ;; a general such operation cannot be portably written, + ;; considering how much CL relies on side-effects to global data structures. (let ((name (coerce-name system))) - (remhash name *defined-systems*) - (unset-asdf-cache-entry `(locate-system ,name)) - (unset-asdf-cache-entry `(find-system ,name)) - nil)) + (unless (and *immutable-systems* (gethash name *immutable-systems*)) + (remhash (coerce-name name) *defined-systems*) + (unset-asdf-cache-entry `(locate-system ,name)) + (unset-asdf-cache-entry `(find-system ,name)) + t))) (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-system name))) (register-hook-function '*post-upgrade-cleanup-hook* 'clear-defined-systems nil) - (defun clear-system (name) - "Clear the entry for a system in the database of systems previously loaded. -Note that this does NOT in any way cause the code of the system to be unloaded." - ;; There is no "unload" operation in Common Lisp, and - ;; a general such operation cannot be portably written, - ;; considering how much CL relies on side-effects to global data structures. - (remhash (coerce-name name) *defined-systems*)) - (defun map-systems (fn) "Apply FN to each defined system. @@ -232,26 +286,6 @@ Going forward, we recommend new users should be using the source-registry. (list new) (subseq *central-registry* (1+ position)))))))))) - (defvar *preloaded-systems* (make-hash-table :test 'equal)) - - (defun make-preloaded-system (name keys) - (apply 'make-instance (getf keys :class 'system) - :name name :source-file (getf keys :source-file) - (remove-plist-keys '(:class :name :source-file) keys))) - - (defun sysdef-preloaded-system-search (requested) - (let ((name (coerce-name requested))) - (multiple-value-bind (keys foundp) (gethash name *preloaded-systems*) - (when foundp - (make-preloaded-system name keys))))) - - (defun register-preloaded-system (system-name &rest keys) - (setf (gethash (coerce-name system-name) *preloaded-systems*) keys)) - - (dolist (s '("asdf" "uiop" "asdf-driver" "asdf-defsystem" "asdf-package-system")) - ;; don't bother with these, no one relies on them: "asdf-utils" "asdf-bundle" - (register-preloaded-system s :version *asdf-version*)) - (defmethod find-system ((name null) &optional (error-p t)) (when error-p (sysdef-error (compatfmt "~@<NIL is not a valid system name~@:>")))) @@ -263,7 +297,9 @@ Going forward, we recommend new users should be using the source-registry. ;; 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*)) + (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-asdf-cache () (with-standard-io-syntax @@ -331,25 +367,6 @@ Going forward, we recommend new users should be using the source-registry. old-version old-pathname version pathname)))) nil))))) ;; only issue the warning the first time, but always return nil - (defvar *immutable-systems* nil - "An hash-set (equal hash-table mapping keys to T) of systems that are immutable, -i.e. already loaded in memory and not to be refreshed from the filesystem. -They will be treated specially by find-system, and passed as :force-not argument to make-plan. - -If you deliver an image with many systems precompiled, *and* do not want to check the filesystem -for them every time a user loads an extension, what more risk a problematic upgrade or catastrophic -downgrade, before you dump an image, use: - (setf asdf::*immutable-systems* (uiop:list-to-hash-set (asdf:already-loaded-systems)))") - - (defun sysdef-immutable-system-search (requested) - (let ((name (coerce-name requested))) - (when (and *immutable-systems* (gethash name *immutable-systems*)) - (or (cdr (system-registered-p requested)) - (error 'formatted-system-definition-error - :format-control "Requested system ~A is in the *immutable-systems* set, ~ -but not loaded in memory" - :format-arguments (list name)))))) - (defun locate-system (name) "Given a system NAME designator, try to locate where to load the system from. Returns five values: FOUNDP FOUND-SYSTEM PATHNAME PREVIOUS PREVIOUS-TIME @@ -389,7 +406,8 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (unless (equal name primary-name) (find-system primary-name nil))) (or (and *immutable-systems* (gethash name *immutable-systems*) - (cdr (system-registered-p name))) + (or (cdr (system-registered-p name)) + (sysdef-preloaded-system-search name))) (multiple-value-bind (foundp found-system pathname previous previous-time) (locate-system name) (assert (eq foundp (and (or found-system pathname previous) t))) diff --git a/header.lisp b/header.lisp index 031e673f73b7cd5d728c14d44821474842e91d43..95b8ac5b6e7e7c88f7b05a3e249281b913b21ea9 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.4.15: Another System Definition Facility. +;;; This is ASDF 3.1.4.17: 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 35db8c4ad3125e67badf7417045235fa92fc1cda..c13264cfa23245a20704e3b7410b313811ee8f21 100644 --- a/interface.lisp +++ b/interface.lisp @@ -16,7 +16,7 @@ ;; 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 + #:defsystem #:find-system #:load-asd #:locate-system #:coerce-name #:primary-system-name #:oos #:operate #:make-plan #:perform-plan #:sequential-plan #:system-definition-pathname #:search-for-system-definition #:find-component #:component-find-path @@ -58,6 +58,8 @@ #:static-file #:doc-file #:html-file #:file-type #:source-file-type + #:register-preloaded-system #:register-immutable-system + #:package-inferred-system #:register-system-packages #:package-system ;; backward-compatibility during migration, to be removed in a further release. diff --git a/operate.lisp b/operate.lisp index e69e249ca6f1f36abc1b3abccc1dc55570794ecf..5e0f19ccabd18f5c97a1d92dd1d0484ee351661e 100644 --- a/operate.lisp +++ b/operate.lisp @@ -161,19 +161,26 @@ to load it in current image." (apply 'operate 'test-op system args) t)) - -;;;; Define require-system, to be hooked into CL:REQUIRE when possible, -;; i.e. for ABCL, CLISP, ClozureCL, CMUCL, ECL, MKCL and SBCL +;;;;; Define the function REQUIRE-SYSTEM, that, similarly to REQUIRE, +;; only tries to load its specified target if it's not loaded yet. (with-upgradability () - (defun component-loaded-p (c) - (action-already-done-p nil (make-instance 'load-op) (find-component c ()))) + (defun component-loaded-p (component) + "has given COMPONENT been successfully loaded in the current image (yet)?" + (action-already-done-p nil (make-instance 'load-op) (find-component component ()))) (defun already-loaded-systems () + "return a list of the names of the systems that have been successfully loaded so far" (remove-if-not 'component-loaded-p (registered-systems))) - (defun require-system (s &rest keys &key &allow-other-keys) - (apply 'load-system s :force-not (already-loaded-systems) keys)) + (defun require-system (system &rest keys &key &allow-other-keys) + "Ensure the specified SYSTEM is loaded, passing the KEYS to OPERATE, but skip any update to the +system or its dependencies if they have already been loaded." + (apply 'load-system system :force-not (already-loaded-systems) keys))) + +;;;; Define the class REQUIRE-SYSTEM, to be hooked into CL:REQUIRE when possible, +;; i.e. for ABCL, CLISP, ClozureCL, CMUCL, ECL, MKCL and SBCL +(with-upgradability () (defvar *modules-being-required* nil) (defclass require-system (system) diff --git a/test/test-cache.script b/test/test-cache.script index 4ac015f71397d8cff9cb309629fd91b8b44325d5..15ce3e5fae58ec80cf07dbb5112184e4b926fdb0 100644 --- a/test/test-cache.script +++ b/test/test-cache.script @@ -24,7 +24,7 @@ (defun clear-caches-and-search () (setf asdf:*central-registry* nil) - (mapc #'asdf/find-system:clear-defined-system *all-systems*)) + (mapc #'clear-system *all-systems*)) (clear-caches-and-search) (assert (not (asdf:find-system "test-asdf/force1" nil))) diff --git a/test/test-preloaded.script b/test/test-preloaded.script new file mode 100644 index 0000000000000000000000000000000000000000..032726d3482d477868977100d4134ae49727e3dc --- /dev/null +++ b/test/test-preloaded.script @@ -0,0 +1,33 @@ +;;; -*- Lisp -*- +(in-package :asdf-test) + +(DBG "Consider a system that does not exist. Loading it fails.") +(assert (null (find-system :this-system-does-not-exist nil))) +(errors missing-component (load-system :this-system-does-not-exist)) + +(DBG "Now let's register it as preloaded. Loading it will work!") +(register-preloaded-system :this-system-does-not-exist :version "3.14") +(assert (null (system-registered-p :this-system-does-not-exist))) ;; not yet registered as loaded +(load-system :this-system-does-not-exist) ;; but now we can load it +(assert (system-registered-p :this-system-does-not-exist)) ;; and it is loaded indeed! + + +(DBG "Now let's load a simple system. It should create a package.") +(load-system :test-asdf/1) +(assert (find-package :test-package)) + +(DBG "Destroy the package, clear the system and load it again. The package should be back.") +(delete-package :test-package) (clear-system :test-asdf/1) +(load-system :test-asdf/1) +(assert (find-package :test-package)) + +(DBG "Destroy the package, clear the system, and register it as immutable. Try loading it again.") +(DBG "The package should NOT be back, because it's immutable thus it's NOT going to be loaded.") +(delete-package :test-package) (clear-system :test-asdf/1) +(assert (null (system-registered-p :test-asdf/1))) ;; not registered as loaded +(register-immutable-system :test-asdf/1) +(assert (system-registered-p :test-asdf/1)) ;; now it's registered as loaded +(load-system :test-asdf/1) +(assert (system-registered-p :test-asdf/1)) ;; and it is "loaded" indeed! +(assert (null (find-package :test-package))) ;; but the source code wasn't loaded + diff --git a/test/test-sysdef-asdf.script b/test/test-sysdef-asdf.script index 1c1a2a87af3a162a88bdfdeaef5f57e125481f8a..e63175652851969a89a6b7490d15fa05babab78d 100644 --- a/test/test-sysdef-asdf.script +++ b/test/test-sysdef-asdf.script @@ -15,7 +15,7 @@ (declare (ignore system)) (subpathname *test-directory* "always-error.lisp")) -(asdf::clear-defined-system "asdf") +(clear-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") @@ -25,7 +25,7 @@ (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") + (clear-system "asdf") (upgrade-asdf)) (assert-equal state "Caught warning") (DBG "2nd bogus attempt at loading same old ASDF: should ignore without a warning") @@ -33,7 +33,7 @@ ((simple-warning #'(lambda (c) (error "Should not have issued warning, but did issue:~% ~A" c)))) - (asdf::clear-defined-system "asdf") + (clear-system "asdf") (upgrade-asdf))) (DBG "Load ASDF with proper configuration: should find asdf.asd from the source above") @@ -42,14 +42,14 @@ (:directory ,*asdf-directory*) (:directory ,*uiop-directory*) :ignore-inherited-configuration)) -(asdf::clear-defined-system "asdf") +(clear-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") +(clear-system "asdf") #-xcl ;; expected-failure: XCL has trouble with the ASDF upgrade (load-system :asdf) (assert-pathname-equal (subpathname *asdf-directory* "asdf.asd") diff --git a/test/test-touch-system-1.script b/test/test-touch-system-1.script index a8b1e72d09679bb510241d8f3e8f855ae573ae07..831d442b072950197cafbda3f20ba690d551c316 100644 --- a/test/test-touch-system-1.script +++ b/test/test-touch-system-1.script @@ -15,7 +15,7 @@ (defparameter date2 (- date1 600)) (defparameter date3 (- date1 300)) -(asdf::clear-defined-system :test1) +(clear-system :test1) (touch-file test1.asd :timestamp date2) (touch-file file1.lisp :timestamp date3) (touch-file file2.lisp :timestamp date3) @@ -29,7 +29,7 @@ (assert-compare (>= date4 date3)) (sleep 1) -(asdf::clear-defined-system :test1) +(clear-system :test1) (touch-file test1.asd) (find-system :test1) (defparameter date6 (system-registered-time :test1)) diff --git a/test/test-try-refinding.script b/test/test-try-refinding.script index ec1da8d30ff42e642c4a73294970edab4572deea..430eca31e07eda420b9b56294fff1dd4216b3179 100644 --- a/test/test-try-refinding.script +++ b/test/test-try-refinding.script @@ -12,8 +12,8 @@ (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")) + (clear-system "test-asdf") + (clear-system "test-asdf/force1")) (DBG "Clearing the caches and finding.") (clear-caches-and-search) diff --git a/test/test-utilities.script b/test/test-utilities.script index a1cb12e3ae80ec229b91d2eb3e288fe15dfbc70a..ae9456ecbb86d6caff56d8e293e88cf538f0df14 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -2,9 +2,12 @@ (defun getcwd-from-run-program () (uiop:parse-native-namestring - (run-program - (os-cond ((os-unix-p) "pwd") ((os-windows-p) "echo %cd%")) - :output '(:string :stripped t)) + (nest + ;; TODO: fix run-program to use POWERSHELL.EXE rather than CMD, and remove this kluge. + #+os-windows (string-trim " ") + (run-program + (os-cond ((os-unix-p) '("pwd" "-P")) ((os-windows-p) "echo %cd%")) + :output '(:string :stripped t))) :ensure-directory t)) (let ((asdf-directory (truename *asdf-directory*))) @@ -244,7 +247,7 @@ (delete-empty-directory (subpathname *build-directory* "deleteme/a/b/e/")) (assert (not (directory-exists-p (subpathname *build-directory* "deleteme/a/b/e/")))) (delete-directory-tree (subpathname *build-directory* "deleteme/") - :validate (lambda (x) (and (<= 5 (length (pathname-directory x))) + :validate (lambda (x) (and (<= 4 (length (pathname-directory x))) (subpathp x *build-directory*)))) (assert (not (directory-exists-p (subpathname *build-directory* "deleteme/a/b/c/")))) (assert (not (directory-exists-p (subpathname *build-directory* "deleteme/a/b/d/")))) diff --git a/uiop/filesystem.lisp b/uiop/filesystem.lisp index 5c6e39dcd0e5af5107cb86e3b6923ff02f30daa2..1ce4d1a1682fb93adb8656a45c447b19474ae29c 100644 --- a/uiop/filesystem.lisp +++ b/uiop/filesystem.lisp @@ -635,18 +635,18 @@ If you're suicidal or extremely confident, just use :VALIDATE T." ((not (and (pathnamep directory-pathname) (directory-pathname-p directory-pathname) (physical-pathname-p directory-pathname) (not (wild-pathname-p directory-pathname)))) (error "~S was asked to delete ~S but it is not a physical non-wildcard directory pathname" - 'delete-filesystem-tree directory-pathname)) + 'delete-directory-tree directory-pathname)) ((not validatep) (error "~S was asked to delete ~S but was not provided a validation predicate" - 'delete-filesystem-tree directory-pathname)) + 'delete-directory-tree directory-pathname)) ((not (call-function validate directory-pathname)) (error "~S was asked to delete ~S but it is not valid ~@[according to ~S~]" - 'delete-filesystem-tree directory-pathname validate)) + 'delete-directory-tree directory-pathname validate)) ((not (directory-exists-p directory-pathname)) (ecase if-does-not-exist (:error (error "~S was asked to delete ~S but the directory does not exist" - 'delete-filesystem-tree directory-pathname)) + 'delete-directory-tree directory-pathname)) (:ignore nil))) #-(or allegro cmu clozure genera sbcl scl) ((os-unix-p) ;; On Unix, don't recursively walk the directory and delete everything in Lisp, diff --git a/uiop/os.lisp b/uiop/os.lisp index bc36d918e3887ca6279a065660d03453673d915b..819c677c920c349fbc5af873b24e98eab8c208bd 100644 --- a/uiop/os.lisp +++ b/uiop/os.lisp @@ -33,32 +33,29 @@ keywords explicitly." ((eq :and (car x)) (every #'featurep (cdr x))) (t (error "Malformed feature specification ~S" x)))) - (defun os-unix-p () - "Is the underlying operating system some Unix variant?" - (or #+abcl (featurep :unix) - #+(and (not abcl) (or unix cygwin darwin)) t)) - + ;; Starting with UIOP 3.1.5, these are runtime tests. + ;; You may bind *features* with a copy of what your target system offers to test its properties. (defun os-macosx-p () "Is the underlying operating system MacOS X?" ;; OS-MACOSX is not mutually exclusive with OS-UNIX, ;; in fact the former implies the latter. - (or - #+allegro (featurep :macosx) - #+clisp (featurep :macos) - (featurep :darwin))) + (featurep '(:or :darwin (:and :allegro :macosx) (:and :clisp :macos)))) + + (defun os-unix-p () + "Is the underlying operating system some Unix variant?" + (or (featurep '(:or :unix :cygwin)) (os-macosx-p))) (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 mingw64)) t)) + (and (not (os-unix-p)) (featurep '(:or :win32 :windows :mswindows :mingw32 :mingw64)))) (defun os-genera-p () "Is the underlying operating system Genera (running on a Symbolics Lisp Machine)?" - (or #+genera t)) + (featurep :genera)) (defun os-oldmac-p () "Is the underlying operating system an (emulated?) MacOS 9 or earlier?" - (or #+mcl t)) + (featurep :mcl)) (defun detect-os () "Detects the current operating system. Only needs be run at compile-time, diff --git a/uiop/run-program.lisp b/uiop/run-program.lisp index 03f53a89f4b617f3a314d50e9caa3f89f339b9b5..ea2d0150d8392d0e7d4e3af8287326d730f2cbb6 100644 --- a/uiop/run-program.lisp +++ b/uiop/run-program.lisp @@ -737,10 +737,18 @@ It returns a process-info plist with possible keys: (defun %normalize-system-command (command) ;; helper for %USE-SYSTEM (etypecase command - (string command) + (string + (os-cond + ((os-windows-p) + #+allegro + (concatenate 'string "cmd /c " command) + #-allegro command) + (t command))) (list (escape-shell-command (os-cond ((os-unix-p) (cons "exec" command)) + ((os-windows-p) #+allegro (append '("cmd" "/c") command) + #-allegro command) (t command)))))) (defun %redirected-system-command (command in out err directory) ;; helper for %USE-SYSTEM @@ -817,7 +825,7 @@ It returns a process-info plist with possible keys: (values output-result error-output-result exit-code))) (defun run-program (command &rest keys - &key ignore-error-status force-shell + &key ignore-error-status (force-shell nil force-shell-suppliedp) (input nil inputp) (if-input-does-not-exist :error) output (if-output-exists :overwrite) (error-output nil error-output-p) (if-error-output-exists :overwrite) @@ -829,7 +837,8 @@ either a list of strings specifying a program and list of arguments, or a string specifying a shell command (/bin/sh on Unix, CMD.EXE on Windows). Always call a shell (rather than directly execute the command when possible) -if FORCE-SHELL is specified. +if FORCE-SHELL is specified. Similarly, never call a shell if FORCE-SHELL is +specified to be NIL. Signal a continuable SUBPROCESS-ERROR if the process wasn't successful (exit-code 0), unless IGNORE-ERROR-STATUS is specified. @@ -877,6 +886,11 @@ or an indication of failure via the EXIT-CODE of the process" (declare (ignorable ignore-error-status)) #-(or abcl allegro clasp clisp clozure cmu cormanlisp ecl gcl lispworks mcl mkcl sbcl scl xcl) (error "RUN-PROGRAM not implemented for this Lisp") + ;; per doc string, set FORCE-SHELL to T if we get command as a string. But + ;; don't override user's specified preference. [2015/06/29:rpg] + (when (stringp command) + (unless force-shell-suppliedp + (setf force-shell t))) (flet ((default (x xp output) (cond (xp x) ((eq output :interactive) :interactive)))) (apply (if (or force-shell #+(or clasp clisp ecl) (or (not ignore-error-status) t) diff --git a/uiop/utility.lisp b/uiop/utility.lisp index d655a25de88e53e11a00255f4f92e58cba182091..9462880092a08cb3459c70658b85b50056e4a27d 100644 --- a/uiop/utility.lisp +++ b/uiop/utility.lisp @@ -206,7 +206,9 @@ Returns two values: \(A B C\) and \(1 2 3\)." #-scl base-char ;; LW6 has BASE-CHAR < SIMPLE-CHAR < CHARACTER ;; LW7 has BASE-CHAR < BMP-CHAR < SIMPLE-CHAR = CHARACTER - #+lispworks7 lw:bmp-char #+lispworks lw:simple-char + #+(and lispworks (not (or lispworks4 lispworks5 lispworks6))) + lw:bmp-char + #+lispworks lw:simple-char character) :unless (and next (subtypep next type)) :collect type) 'vector)) diff --git a/upgrade.lisp b/upgrade.lisp index 911b53d5819cf55ef919f3e5abd6788356701248..db33cc7ab133b3b1bc2f1a03023a8c765848f62e 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.4.15") + (asdf-version "3.1.4.17") (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 4b322cce7fd3d909bdd9af4c160b7c2258ffa69c..32444778ae74b11f123ebefc6b50dccf5c6c9709 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1,2 +1,2 @@ -"3.1.4.15" +"3.1.4.17"