Commit 2c31e053 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.26.137: API cleanup in preparation for release

Rename RUN-PROGRAM/ to RUN-PROGRAM.
Can't export it from ASDF because it causes a clash in SB-GROVEL.

Rename SUB-OBJECT and :PATH to ACCESS-AT and :AT.

Get rid of TRANSLATE-OUTPUT-P.
Instead, check whether the component's BUILD-OPERATION
is the same as the current operation.
parent a3f8080e
......@@ -15,7 +15,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.26.136" ;; to be automatically updated by make bump-version
:version "2.26.137" ;; to be automatically updated by make bump-version
:depends-on ()
:components ((:module "build" :components ((:file "asdf"))))
:in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op asdf/defsystem))))
......@@ -38,7 +38,6 @@
:class :bundle-system
:build-operation monolithic-concatenate-source-op
:bundle-pathname "build/asdf"
:translate-output-p nil
:serial t
:around-compile call-without-redefinition-warnings ;; be the same as asdf-driver
:depends-on (:asdf/header :asdf-driver)
......
......@@ -113,12 +113,16 @@ call that function where you would otherwise have loaded and configured A-B-L.")
;;;; run-shell-command
;;
;; WARNING! The function below is dysfunctional and deprecated.
;; Please use asdf/run-program:run-program/ instead.
;; Please use asdf/run-program:run-program instead.
;;
(defun* run-shell-command (control-string &rest args)
"Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
synchronously execute the result using a Bourne-compatible shell, with
output to *VERBOSE-OUT*. Returns the shell's exit code."
output to *VERBOSE-OUT*. Returns the shell's exit code.
PLEASE DO NOT USE.
Deprecated function, for backward-compatibility only.
Please use ASDF-DRIVER:RUN-PROGRAM instead."
(let ((command (apply 'format nil control-string args)))
(asdf-message "; $ ~A~%" command)
(run-program/ command :force-shell t :ignore-error-status t :output *verbose-out*)))
(run-program command :force-shell t :ignore-error-status t :output *verbose-out*)))
......@@ -18,7 +18,6 @@
#+ecl #:make-build
#:register-pre-built-system
#:build-args #:name-suffix #:prologue-code #:epilogue-code #:static-library
#:component-translate-output-p #:translate-output-p
#:component-bundle-pathname #:bundle-pathname
#:component-entry-point #:entry-point))
(in-package :asdf/bundle)
......@@ -80,15 +79,11 @@
((bundle-type :initform :program)))
(defgeneric* component-bundle-pathname (component))
(defgeneric* component-translate-output-p (component))
(defgeneric* component-entry-point (component))
(defmethod component-bundle-pathname ((c component))
(declare (ignorable c))
nil)
(defmethod component-translate-output-p ((c component))
(declare (ignorable c))
t)
(defmethod component-entry-point ((c component))
(declare (ignorable c))
nil)
......@@ -97,9 +92,7 @@
((bundle-pathname
:initform nil :initarg :bundle-pathname :accessor component-bundle-pathname)
(entry-point
:initform nil :initarg :entry-point :accessor component-entry-point)
(translate-output-p
:initform nil :initarg :translate-output-p :accessor component-translate-output-p)))
:initform nil :initarg :entry-point :accessor component-entry-point)))
(defun* bundle-pathname-type (bundle-type)
(etypecase bundle-type
......@@ -121,7 +114,7 @@
(format nil "~A~@[~A~]" (component-name c) (slot-value o 'name-suffix))))
(type (bundle-pathname-type bundle-type)))
(values (list (subpathname (component-pathname c) name :type type))
(not (component-translate-output-p c)))))))
(eq (type-of o) (component-build-operation c)))))))
(defmethod output-files ((o bundle-op) (c system))
(bundle-output-files o c))
......
......@@ -90,8 +90,8 @@
(cons
(ecase (first form)
((:read-file-form)
(destructuring-bind (subpath &key (path 0)) (rest form)
(safe-read-file-form (subpathname pathname subpath) :path path)))))))
(destructuring-bind (subpath &key (at 0)) (rest form)
(safe-read-file-form (subpathname pathname subpath) :at at)))))))
;;; Main parsing function
......
......@@ -261,12 +261,15 @@ whether a recent version is loaded, an old version is loaded,
or none at all:
@lisp
(or #+asdf2 (asdf:asdf-version) #+asdf :old)
(when (find-package :asdf)
(or (symbol-value (or (find-symbol (string :*asdf-version*) :asdf)
(find-symbol (string :*asdf-revision*) :asdf)))
:antique))
@end lisp
If it returns a version number, that's the version of ASDF installed.
If it returns the keyword @code{:OLD},
then you're using an old version of ASDF (from before 1.635).
If it returns a version number as a string, that's the version of ASDF installed.
If it returns a version number as a list, that's an old CVS version from before 1.365.
If it returns the keyword @code{:ANTIQUE}, it's so old that's not funny.
If it returns @code{NIL} then ASDF is not installed.
If you are experiencing problems with ASDF,
......@@ -277,12 +280,18 @@ before you contact us and raise an issue.
@section Upgrading ASDF
If your implementation provides ASDF 2.27 or later,
you only need to @code{(require "asdf")}:
ASDF will automatically look whether an updated version of itself is available
amongst the regularly configured systems, before it compiles anything else.
See @pxref{Configuring ASDF} below.
If your implementation does provide ASDF 2 or later,
but not ASDF 2.27 or later,
and you want to upgrade to a more recent version,
just install ASDF like any other package
(see @pxref{Loading ASDF,,Loading an otherwise installed ASDF} below),
configure ASDF as usual (see @pxref{Configuring ASDF} below),
and upgrade with:
you need to install and configure your ASDF as above,
and additionally, you need to explicitly tell ASDF to load itself,
right after you require your implementation's old ASDF 2:
@lisp
(require "asdf")
......@@ -290,7 +299,9 @@ and upgrade with:
@end lisp
If on the other hand, your implementation only provides an old ASDF,
you will require a special configuration step and an old-style loading:
you will require a special configuration step and an old-style loading.
Take special attention to not omit the trailing directory separator
@code{/} at the end of your pathname:
@lisp
(require "asdf")
......@@ -298,9 +309,7 @@ you will require a special configuration step and an old-style loading:
(asdf:oos 'asdf:load-op :asdf)
@end lisp
Don't forget the trailing @code{/} at the end of your pathname.
Also, note that older versions of ASDF won't redirect their output,
Note that ASDF 1 won't redirect its output files,
or at least won't do it according to your usual ASDF 2 configuration.
You therefore need write access on the directory
where you install the new ASDF,
......@@ -312,7 +321,11 @@ Note that to our knowledge all implementations that provide ASDF
provide ASDF 2 in their latest release, so
you may want to upgrade your implementation rather than go through that hoop.
Finally, note that there are some limitations to upgrading ASDF:
Finally, if you are using an unmaintained implementation
that does not provide ASDF at all,
see @pxref{Loading ASDF,,Loading an otherwise installed ASDF} below.
Note that there are some limitations to upgrading ASDF:
@itemize
@item
Previously loaded ASDF extension becomes invalid, and will need to be reloaded.
......@@ -321,13 +334,15 @@ Since it isn't possible to automatically detect what extensions are present
that need to be invalidated,
ASDF will actually invalidate all previously loaded systems
when it is loaded on top of a different ASDF version,
starting with ASDF 2.014.8 (as far as releases go, 2.015).
starting with ASDF 2.014.8 (as far as releases go, 2.015);
and it will automatically attempt this self-upgrade as its very first step
starting with ASDF 2.27.
@item
For this an many other reasons,
it important reason to load, configure and upgrade ASDF (if needed)
as one of the very first things done by your build and startup scripts.
Until all implementations provide ASDF 2.015 or later,
Until all implementations provide ASDF 2.27 or later,
it is safer if you upgrade ASDF and its extensions as a special step
at the very beginning of whatever script you are running,
before you start using ASDF to load anything else;
......@@ -335,7 +350,7 @@ even afterwards, it is still a good idea, to avoid having to
load and reload code twice as it gets invalidated.
@item
Until all implementations provide ASDF 2.015 or later,
Until all implementations provide ASDF 2.27 or later,
it is unsafe to upgrade ASDF as part of loading a system
that depends on a more recent version of ASDF,
since the new one might shadow the old one while the old one is running,
......@@ -851,9 +866,13 @@ Instead of a string representing the version,
the @code{:version} argument can be an expression that is resolved to
such a string using the following trivial domain-specific language:
in addition to being a literal string, it can be an expression of the form
@code{(:read-file-form <pathname-or-string>)}, which will be resolved
by reading the first form in the specified pathname or string
(merged against the pathname of the current system if relative).
@code{(:read-file-form <pathname-or-string> :at <access-at-specifier>)},
which will be resolved by reading a form
in the specified pathname
(read as a subpathname of the current system if relative or a unix-namestring).
You may use an access-at specifier with the (optional) :at keyword,
by default the specifier is 0, meaning the first form is returned.
@cindex :version
@end itemize
......@@ -2243,6 +2262,30 @@ Additionally, some implementation-specific directories
may be automatically prepended to whatever directories are specified
in configuration files, no matter if the last one inherits or not.
@section Truenames and other dangers
One great innovation of the original ASDF was its ability to leverage
@code{CL:TRUENAME} to locate where your source code was and where to build it,
allowing for symlink farms as a simple but effective configuration mechanism
that is easy to control programmatically.
ASDF2 still supports this configuration style, and it is enabled by default;
however we recommend you instead use
our source-registry configuration mechanism described below,
because it is easier to setup in a portable way across users and implementations.
Addtionally, some people dislike truename,
either because it is very slow on their system, or
because they are using content-addressed storage where the truename of a file
is related to a digest of its individual contents,
and not to other files in the same intended project.
For these people, ASDF 2.27 allows to eschew the @code{TRUENAME} mechanism,
by setting the variable @var{asdf:*resolve-symlinks*} to @code{NIL}.
PS: Yes, if you haven't read Vernor Vinge's short but great classic
``True Names... and Other Dangers'' then you're in for a treat.
@section XDG base directory
Note that we purport to respect the XDG base directory specification
......@@ -2260,10 +2303,9 @@ On Windows platforms, when not using Cygwin,
instead of the XDG base directory specification,
we try to use folder configuration from the registry regarding
@code{Common AppData} and similar directories.
However, support for querying the Windows registry is limited as of ASDF 2,
and on many implementations, we may fall back to always using the defaults
without consulting the registry.
Patches welcome.
Since support for querying the Windows registry
is not possible to do in reasonable amounts of portable Common Lisp code,
ASDF 2 relies on the environment variables that Windows usually exports.
@section Backward Compatibility
......@@ -3448,22 +3490,99 @@ with respect to its own code, and what it does is ridiculously complex;
look at the beginning of @file{asdf.lisp} to see what it does.
@end defun
@defun run-program
run-program takes a @var{COMMAND} argument that is either
a list of a program path and its arguments,
or a string to be executed by a shell.
It spawns the command, waits for it to return,
verifies that it exited cleanly (unless told not too below),
and optionally captures and processes its output.
It accepts many keyword arguments to configure its behavior.
@code{output} is its most important argument;
it specifies how the output is captured and processed.
If it is @code{nil}, then the output is not captured.
If it is @code{:interactive}, then
input and output are inherited from the current process,
which the subprocess can control until it exits.
Otherwise, the output is captured and redirected to a stream,
and processed by @code{slurp-input-stream} with the object as first argument.
See below.
@code{element-type} and @code{external-format} are passed on
to your Lisp implementation, when available, for creation of the output stream.
@code{force-shell} forces evaluation of the command through a shell,
even if it was passed as a list rather than a string.
@code{ignore-error-status} causes @code{run-program}
to not raise an error if the spawned program exits in error.
Following POSIX convention, an error is anything but
a normal exit with status code zero.
run-program works on all platforms supported by ASDF, except Genera.
@end defun
@defun slurp-input-stream
It's a generic function of two arguments, a target object and an input stream,
and accepting keyword arguments.
Predefined methods based on the target object are as follow:
If the object is a function, the function is called with the stream as argument.
If the object is a cons, its first element is applied to its rest appended by
a list of the input stream.
If the object is an output stream, the contents of the input stream are copied to it.
If the linewise argument is provided, copying happens line by line,
and an optional prefix is printed before each line.
Otherwise, copying happen based on a buffer of size buffer-size,
using the element-type.
If the object is 'string or :string, the content is captured into a string
of the given element-type.
If the object is :lines, the content is captured as a list of strings,
one per line, without line ending. If the count argument is provided,
it is a maximum count of lines to be read.
If the object is :line, the content is capture as with :lines above,
and then its sub-object is extracted with the path argument,
which defaults to 0, extracting the first line.
A number will extract the corresponding line.
See the documentation for asdf-driver:sub-object.
If the object is :forms, the content is captured as a list of S-expressions,
as read by the Lisp reader.
If the count argument is provided,
it is a maximum count of lines to be read.
We recommend you control the syntax with such macro as
asdf-driver:with-safe-io-syntax.
If the object is :form, the content is capture as with :forms above,
and then its sub-object is extracted with the path argument,
which defaults to 0, extracting the first form.
A number will extract the corresponding form.
See the documentation for asdf-driver:sub-object.
We recommend you control the syntax with such macro as
asdf-driver:with-safe-io-syntax.
@end defun
@defun run-shell-command
This function is obsolete and present only for the sake of backwards-compatibility:
``If it's not backwards, it's not compatible''. We strongly discourage its use.
Its current behavior is only well-defined on Unix platforms
(which include MacOS X and cygwin). On Windows, anything goes.
The following documentation is only for the purpose of your migrating away from it
in a way that preserves semantics.
Instead we recommend the use of such a function as
@code{xcvb-driver:run-program/}
from the @code{xcvb-driver} system that is distributed with XCVB:
@url{http://common-lisp.net/project/xcvb}.
It's the only alternative that supports
as many implementations and operating systems as ASDF does,
and provides well-defined behavior outside Unix (i.e. on Windows).
(The only unsupported exception is Genera, since on it
@code{run-shell-command} doesn't make sense anyway on that platform).
Instead we recommend the use @code{run-program} above
available as part of ASDF since ASDF 2.27.
@code{run-shell-command} takes as arguments a @code{format} control-string
and arguments to be passed to @code{format} after this control-string
......@@ -3642,11 +3761,16 @@ The following issues and many others have been fixed:
@itemize
@item
The infamous TRAVERSE function has been revamped completely,
with many bugs squashed.
The infamous TRAVERSE function has been revamped completely
between ASDF 1 and ASDF 2, with many bugs squashed.
In particular, dependencies were not correctly propagated
across modules but now are.
Timestamps were not correctly propagated at all.
It has been completely rewritten many times over
between ASDF 2.000 and ASDF 2.27,
with fundamental issues in the original model being fixed.
Timestamps were not propagated at all, and now are.
The internal model of how actions depend on each other
is now both consistent and complete.
The :version and
the :force (system1 .. systemN) feature have been fixed.
......@@ -3671,7 +3795,7 @@ except for GCL (due to GCL bugs).
@item
Support was lacking for some implementations.
ABCL and GCL were notably wholly broken.
ECL extensions were not integrated in the ASDF release.
ECL extensions were not integrated with ASDF release.
@item
The documentation was grossly out of date.
......
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
;;; This is ASDF 2.26.136: Another System Definition Facility.
;;; This is ASDF 2.26.137: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......
......@@ -33,7 +33,7 @@
#:input-files #:output-files #:output-file #:perform
#:operation-done-p #:explain #:component-sibling-dependencies
#:needed-in-image-p
#:run-program/ ; the recommended replacement for run-shell-command
;; #: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 #:precompiled-system #:compiled-file #:bundle-system
#+ecl #:make-build
......
......@@ -282,7 +282,7 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
#+cormanlisp (pathname (pl::get-current-directory)) ;; Q: what type does it return?
#+ecl (ext:getcwd)
#+gcl (parse-native-namestring ;; this is a joke. Isn't there a better way?
(first (symbol-call :asdf/driver :run-program/ '("/bin/pwd") :output :lines)))
(first (symbol-call :asdf/driver :run-program '("/bin/pwd") :output :lines)))
#+genera *default-pathname-defaults* ;; on a Lisp OS, it *is* canonical!
#+lispworks (system:current-directory)
#+mkcl (mk-ext:getcwd)
......
;;;; -------------------------------------------------------------------------
;;;; run-program/ initially from xcvb-driver.
;;;; run-program initially from xcvb-driver.
(asdf/package:define-package :asdf/run-program
(:recycle :asdf/run-program :xcvb-driver)
......@@ -10,9 +10,9 @@
#:escape-windows-token #:escape-windows-command
#:escape-token #:escape-command
;;; run-program/
;;; run-program
#:slurp-input-stream
#:run-program/
#:run-program
#:subprocess-error
#:subprocess-error-code #:subprocess-error-command #:subprocess-error-process
))
......@@ -145,9 +145,10 @@ by /bin/sh in POSIX"
#-(or gcl<2.7 genera)
(defmethod slurp-input-stream ((output-stream stream) input-stream
&key (element-type 'character) &allow-other-keys)
&key linewise prefix (element-type 'character) buffer-size &allow-other-keys)
(copy-stream-to-stream
input-stream output-stream :element-type element-type))
input-stream output-stream
:linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size))
(defmethod slurp-input-stream ((x (eql 'string)) stream &key &allow-other-keys)
(declare (ignorable x))
......@@ -157,29 +158,34 @@ by /bin/sh in POSIX"
(declare (ignorable x))
(slurp-stream-string stream))
(defmethod slurp-input-stream ((x (eql :lines)) stream &rest keys &key &allow-other-keys)
(defmethod slurp-input-stream ((x (eql :lines)) stream &key count &allow-other-keys)
(declare (ignorable x))
(apply 'slurp-stream-lines stream keys))
(slurp-stream-lines stream :count count))
(defmethod slurp-input-stream ((x (eql :line)) stream &rest keys &key &allow-other-keys)
(defmethod slurp-input-stream ((x (eql :line)) stream &key (at 0) &allow-other-keys)
(declare (ignorable x))
(apply 'slurp-stream-line stream keys))
(slurp-stream-line stream :at at))
(defmethod slurp-input-stream ((x (eql :forms)) stream &rest keys &key &allow-other-keys)
(defmethod slurp-input-stream ((x (eql :forms)) stream &key count &allow-other-keys)
(declare (ignorable x))
(apply 'slurp-stream-forms stream keys))
(slurp-stream-forms stream :count count))
(defmethod slurp-input-stream ((x (eql :form)) stream &rest keys &key &allow-other-keys)
(defmethod slurp-input-stream ((x (eql :form)) stream &key (at 0) &allow-other-keys)
(declare (ignorable x))
(apply 'slurp-stream-form stream keys))
(slurp-stream-form stream :at at))
(defmethod slurp-input-stream (x stream &key (element-type 'character) &allow-other-keys)
(declare (ignorable stream element-type))
(defmethod slurp-input-stream (x stream
&key linewise prefix (element-type 'character) buffer-size
&allow-other-keys)
(declare (ignorable linewise prefix element-type buffer-size))
(cond
#+(or gcl<2.7 genera)
((functionp x) (funcall x stream))
#+(or gcl<2.7 genera)
((output-stream-p x) (copy-stream-to-stream stream x :element-type element-type))
((output-stream-p x)
(copy-stream-to-stream
input-stream output-stream
:linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size))
(t
(error "Invalid ~S destination ~S" 'slurp-input-stream x))))
......@@ -198,7 +204,7 @@ by /bin/sh in POSIX"
(subprocess-error-command condition)
(subprocess-error-code condition)))))
(defun* run-program/ (command
(defun* run-program (command
&key output ignore-error-status force-shell
(element-type *default-stream-element-type*)
(external-format :default)
......@@ -217,7 +223,7 @@ Return the exit status code of the process that was called.
Use ELEMENT-TYPE and EXTERNAL-FORMAT for the stream passed to the OUTPUT processor."
(declare (ignorable ignore-error-status element-type external-format))
#-(or abcl allegro clisp clozure cmu cormanlisp ecl gcl lispworks mcl sbcl scl xcl)
(error "RUN-PROGRAM/ not implemented for this Lisp")
(error "RUN-PROGRAM not implemented for this Lisp")
(labels (#+(or allegro clisp clozure cmu ecl (and lispworks os-unix) sbcl scl)
(run-program (command &key pipe interactive)
"runs the specified command (a list of program and arguments).
......
......@@ -153,16 +153,27 @@ Useful for portably flushing I/O before user input or program exit."
;;; Simple Whole-Stream processing
(defun* copy-stream-to-stream (input output &key (element-type 'character) (buffer-size 8192))
"Copy the contents of the INPUT stream into the OUTPUT stream,
using WRITE-SEQUENCE and a sensibly sized buffer."
(defun* copy-stream-to-stream (input output &key element-type buffer-size linewise prefix)
"Copy the contents of the INPUT stream into the OUTPUT stream.
If LINEWISE is true, then read and copy the stream line by line, with an optional PREFIX.
Otherwise, using WRITE-SEQUENCE using a buffer of size BUFFER-SIZE."
(with-open-stream (input input)
(loop
:for buffer = (make-array (list buffer-size) :element-type element-type)
:for end = (read-sequence buffer input)
:until (zerop end)
:do (write-sequence buffer output :end end)
(when (< end buffer-size) (return)))))
(if linewise
(loop :for (line eof) = (multiple-value-list (read-line input nil nil))
:while line :do
(when prefix (princ prefix output))
(princ line output)
(unless eof (terpri output))
(finish-output output)
(when eof (return)))
(loop
:with buffer-size = (or buffer-size 8192)
:for buffer = (make-array (list buffer-size) :element-type (or element-type 'character))
:for end = (read-sequence buffer input)
:until (zerop end)
:do (write-sequence buffer output :end end)
(when (< end buffer-size) (return))))))
(defun* concatenate-files (inputs output)
(with-open-file (o output :element-type '(unsigned-byte 8)
......@@ -172,18 +183,6 @@ using WRITE-SEQUENCE and a sensibly sized buffer."
:direction :input :if-does-not-exist :error)
(copy-stream-to-stream i o :element-type '(unsigned-byte 8))))))
(defun* copy-stream-to-stream-line-by-line (input output &key prefix)
"Copy the contents of the INPUT stream into the OUTPUT stream,
reading contents line by line."
(with-open-stream (input input)
(loop :for (line eof) = (multiple-value-list (read-line input nil nil))
:while line :do
(when prefix (princ prefix output))
(princ line output)
(unless eof (terpri output))
(finish-output output)
(when eof (return)))))
(defun* slurp-stream-string (input &key (element-type 'character))
"Read the contents of the INPUT stream as a string"
(with-open-stream (input input)
......@@ -201,9 +200,9 @@ Read no more than COUNT lines."
(read-line input nil nil))
:while l :collect l)))
(defun* slurp-stream-line (input &key (path 0))
(defun* slurp-stream-line (input &key (at 0))
"Read the contents of the INPUT stream as a list of lines,
then return the SUB-OBJECT of that list of lines following the PATH.
then return the ACCESS-AT of that list of lines using the AT specifier.
PATH defaults to 0, i.e. return the first line.
PATH is typically an integer, or a list of an integer and a function.
If PATH is NIL, it will return all the lines in the file.
......@@ -211,13 +210,7 @@ If PATH is NIL, it will return all the lines in the file.
The stream will not be read beyond the Nth lines,
where N is the index specified by path
if path is either an integer or a list that starts with an integer."
(let* ((count (cond
((integerp path)
(1+ path))
((and (consp path) (integerp (first path)))
(1+ (first path)))))
(forms (slurp-stream-lines input :count count)))
(sub-object forms path)))
(access-at (slurp-stream-lines input :count (access-at-count at)) at))
(defun* slurp-stream-forms (input &key count)
"Read the contents of the INPUT stream as a list of forms,
......@@ -235,25 +228,19 @@ BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
(read-preserving-whitespace input nil eof))
:until (eq form eof) :collect form))
(defun* slurp-stream-form (input &key (path 0))
(defun* slurp-stream-form (input &key (at 0))
"Read the contents of the INPUT stream as a list of forms,
then return the SUB-OBJECT of these forms following the PATH.
PATH defaults to 0, i.e. return the first form.
PATH is typically a list of integers.
If PATH is NIL, it will return all the forms in the file.
then return the ACCESS-AT of these forms following the AT.
AT defaults to 0, i.e. return the first form.
AT is typically a list of integers.
If AT is NIL, it will return all the forms in the file.
The stream will not be read beyond the Nth form,
where N is the index specified by path,
if path is either an integer or a list that starts with an integer.
BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
(let* ((count (cond
((integerp path)
(1+ path))
((and (consp path) (integerp (first path)))
(1+ (first path)))))
(forms (slurp-stream-forms input :count count)))
(sub-object forms path)))
(access-at (slurp-stream-forms input :count (access-at-count at)) at))
(defun* read-file-string (file &rest keys)
"Open FILE with option KEYS, read its contents as a string"
......@@ -272,13 +259,13 @@ BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
#'(lambda (input) (slurp-stream-forms input :count count))
(remove-plist-key :count keys)))
(defun* read-file-form (file &rest keys &key (path 0) &allow-other-keys)
"Open input FILE with option KEYS (except path),
and read its contents as per SLURP-STREAM-FORM with given PATH.
(defun* read-file-form (file &rest keys &key (at 0) &allow-other-keys)
"Open input FILE with option KEYS (except AT),
and read its contents as per SLURP-STREAM-FORM with given AT specifier.
BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
(apply 'call-with-input-file file
#'(lambda (input) (slurp-stream-form input :path path))
(remove-plist-key :path keys)))
#'(lambda (input) (slurp-stream-form input :at at))
(remove-plist-key :at keys)))
(defun* safe-read-file-form (pathname &rest keys &key (package :cl) &allow-other-keys)
"Reads the specified form from the top of a file using a safe standardized syntax.
......
......@@ -5,5 +5,4 @@
:build-operation program-op
:entry-point "hello:entry-point"
:depends-on (:asdf-driver)
:translate-output-p nil
:components ((:file "hello")))
......@@ -165,7 +165,7 @@ Some constraints:
(defun touch-file (file &key (offset 0) timestamp)
(let ((timestamp (or timestamp (+ offset (get-universal-time)))))
(multiple-value-bind (sec min hr day month year) (decode-universal-time timestamp #+gcl<2.7 -5)
(acall :run-program/
(acall :run-program
`("touch" "-t" ,(format nil "~4,'0D~2,'0D~2,'0D~2,'0D~2,'0D.~2,'0D"
year month day hr min sec)
,(namestring file)))
......
......@@ -22,8 +22,7 @@
(assert-equal
(output-file mcso sys)
(apply-output-translations
(subpathname *test-directory*
"test-concatenate-source.all-systems.lisp")))
(resolve-output "asdf/test/test-concatenate-source.all-systems.lisp")))
(assert-equal
(output-files mcso sys)
(input-files mccso sys))
......
......@@ -10,7 +10,7 @@
(defparameter asd2 (subpathname tmp "test-multiple-too.asd"))
(defparameter file4 (test-fasl "file4"))
(setf *central-registry* `(,*test-directory* ,tmp))
(run-program/
(run-program
(format nil "/bin/ln -sf ~A ~A 2>&1"
(native-namestring asd)
(native-namestring asd2)))
......
......@@ -28,15 +28,15 @@
(initialize-source-registry `(:source-registry :ignore-inherited-configuration))
(delete-file-if-exists exe)
(run-program/
(run-program
(symbol-call :lisp-invocation :lisp-invocation-arglist
:load (native-namestring (subpathname *test-directory* "make-hello-world.lisp"))))
(assert (probe-file* exe))
(assert-equal (run-program/ `(,(native-namestring exe)) :output :lines)
(assert-equal (run-program `(,(native-namestring exe)) :output :lines)
'("hello, world"))
(assert-equal (run-program/ `(,(native-namestring exe) "a" "b c" "d") :output :lines)
(assert-equal (run-program `(,(native-namestring exe) "a" "b c" "d") :output :lines)
'("hello, world"
"You passed 3 arguments:"
" \"a\""
......
;;; -*- Lisp -*-
;;; TODO: write tests for run-program/ instead -- and/or
;;; TODO: write tests for run-program instead -- and/or
;;; import those from the original xcvb-driver-test
;;; test asdf run-shell-command function
(progn
(when (asdf::os-unix-p)
(setf asdf::*verbose-out* nil)
(assert-equal 1 (asdf:run-shell-command "false"))
(assert-equal 0 (asdf:run-shell-command "true"))
(unless (< 0 (asdf:run-shell-command "./bad-shell-command"))
(error "Failed to capture exit status indicating shell command failure."))
(unless (equal 0 (asdf:run-shell-command "./good-shell-command"))
(error "Failed to capture exit status indicating shell command failure."))
;; NB1: run-shell-command is deprecated. Use run-program/ instead.
;; NB2: we do NOT support stderr capture to *verbose-out* anymore in run-shell-command.
;; If you want 2>&1 redirection, you know where to find it.
(assert-equal '("ok 1") (asdf::run-program/ "echo ok 1" :output :lines))
(assert-equal '("ok 1") (asdf::run-program/ '("echo" "ok 1") :output :lines))
))
(when (asdf::os-unix-p)
(setf asdf::*verbose-out* nil)
(assert-equal 1 (run-shell-command "false"))
(assert-equal 0 (run-shell-command "true"))
(unless (< 0 (asdf:run-shell-command "./bad-shell-command"))
(error "Failed to capture exit status indicating shell command failure."))
(unless (equal 0 (run-shell-command "./good-shell-command"))
(error "Failed to capture exit status indicating shell command failure."))
;; NB1: run-shell-command is deprecated. Use run-program instead.
;; NB2: we do NOT support stderr capture to *verbose-out* anymore in run-shell-command.
;; If you want 2>&1 redirection, you know where to find it.
(assert-equal '("ok 1") (run-program "echo ok 1" :output :lines))
(assert-equal '("ok 1") (run-program '("echo" "ok 1") :output :lines))
t)
......@@ -35,7 +35,7 @@
;; "2.345.6" would be a development version in the official upstream
;; "2.345.0.7" would be your seventh local modification of official release 2.345
;; "2.345.6.7" wo