Commit d728aed3 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Merge branch 'master' into minimakefile

parents 549a853f a23693b1
......@@ -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
......
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
......
......@@ -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,
......
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.
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.
......@@ -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)))
......
;;; -*- 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>.
......
......@@ -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.
......
......@@ -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)
......
......@@ -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)))
......
;;; -*- 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
......@@ -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")
......
......@@ -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))
......
......@@ -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)
......
......@@ -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/"))))
......
......@@ -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,
......
......@@ -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,
......
......@@ -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)
......
......@@ -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))
......
......@@ -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)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment