diff --git a/asdf.asd b/asdf.asd index 7e8e2dde9bfbedee0aa629f87e75beceb19070da..78fd66ba96afe427329b28171f42c763164b3e34 100644 --- a/asdf.asd +++ b/asdf.asd @@ -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) diff --git a/backward-interface.lisp b/backward-interface.lisp index cb441f01229fb725ffa973a77060ee87f1d8965d..df5fd046d3ca3c00062d0d345594bcce887a048a 100644 --- a/backward-interface.lisp +++ b/backward-interface.lisp @@ -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*))) diff --git a/bundle.lisp b/bundle.lisp index cc4348524023b6be0e7464fe17989e37ae170074..e36c9e46341f4a550418118fc2c7872a63b0ddcb 100644 --- a/bundle.lisp +++ b/bundle.lisp @@ -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)) diff --git a/defsystem.lisp b/defsystem.lisp index fdd181c8d64266675812d8973b060bf550326af3..0946be313782910cec7b4c632fef5687450c03aa 100644 --- a/defsystem.lisp +++ b/defsystem.lisp @@ -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 diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index 54f183e442647939102a922af0e8017dfc5354a1..100b3c3cefb6f630c151ad2d0125ef153d6ea6e6 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -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. diff --git a/header.lisp b/header.lisp index af3fcdcbbc2e4d06ba0e67a83ee577b3f5a2ba5a..a9cd15c5c3c2df2459e1dcab60dd8a40104d76f4 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;; -*- 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>. diff --git a/interface.lisp b/interface.lisp index 4a5d50a1b32611491e8504dbdb196eb5aa7044e7..23cfdbb4a8550b5b92b399db26d1d8cda8897988 100644 --- a/interface.lisp +++ b/interface.lisp @@ -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 diff --git a/os.lisp b/os.lisp index 0bef9497b2b837fb23fed5328504d1904adfaf6c..91ce089a397f97d57ce9c60db91d1f83825e6236 100644 --- a/os.lisp +++ b/os.lisp @@ -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) diff --git a/run-program.lisp b/run-program.lisp index 7fb62f5c7f3609b483f56477662d998037a173b4..ced1759ff060430d64d171fbf731cabd2dcf74f0 100644 --- a/run-program.lisp +++ b/run-program.lisp @@ -1,5 +1,5 @@ ;;;; ------------------------------------------------------------------------- -;;;; 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). diff --git a/stream.lisp b/stream.lisp index a67448b6d0be873ae0d3179454f6d6c4f0fe972a..2edda75c24d64247db96b6f14bc6770d850b34f3 100644 --- a/stream.lisp +++ b/stream.lisp @@ -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. diff --git a/test/hello-world-example.asd b/test/hello-world-example.asd index 1f88de1a0e7ebe4bb9f2ebc54da7f4bcc20e5107..8a2f664e1c4bc4b350f733d3e3a4ba6df2590d15 100644 --- a/test/hello-world-example.asd +++ b/test/hello-world-example.asd @@ -5,5 +5,4 @@ :build-operation program-op :entry-point "hello:entry-point" :depends-on (:asdf-driver) - :translate-output-p nil :components ((:file "hello"))) diff --git a/test/script-support.lisp b/test/script-support.lisp index 411f73756a5e13161e5f25aeecb05b7582b01711..9728b1f8e7d05bb12e797b4ea09b52909f471487 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -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))) diff --git a/test/test-concatenate-source.script b/test/test-concatenate-source.script index 6c3781fffd7087b8bca5ce05831ea66c0c610b3c..e1c8260eda8295e1d4cfc26fbdd328900310f2cb 100644 --- a/test/test-concatenate-source.script +++ b/test/test-concatenate-source.script @@ -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)) diff --git a/test/test-multiple.script b/test/test-multiple.script index 2680c93f85fd775e14f22583687f68ea1cc716d5..e3cf69794677b77996f6dc980adb67ef1f5a4d3f 100644 --- a/test/test-multiple.script +++ b/test/test-multiple.script @@ -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))) diff --git a/test/test-program.script b/test/test-program.script index c6835d724b6f32e0e594d41a164839ac6358dce8..8f3aff07721b82e435208c7c00e9f46fe66b7d74 100644 --- a/test/test-program.script +++ b/test/test-program.script @@ -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\"" diff --git a/test/test-run-program.script b/test/test-run-program.script index e84dc1a0cd20b3ffd3737ca04d65480c4e9d0d11..9ebf51bb7b8203b37a287f717cf72c19644ea005 100644 --- a/test/test-run-program.script +++ b/test/test-run-program.script @@ -1,23 +1,21 @@ ;;; -*- 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) diff --git a/upgrade.lisp b/upgrade.lisp index b7caeae682c95790a0136a82b5e3939194d5aacb..b9e3a15481459902856ea0d18e1297c3e882d749 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -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" would be your seventh local modification of development version 2.345.6 - (asdf-version "2.26.136") + (asdf-version "2.26.137") (existing-asdf (find-class (find-symbol* :component :asdf nil) nil)) (existing-version *asdf-version*) (already-there (equal asdf-version existing-version)) diff --git a/utility.lisp b/utility.lisp index 5b877b4dc50d9bde6ab66faf137036ba138cb095..97d91c0d53b3059bef35d2ce5fcb322acf843251 100644 --- a/utility.lisp +++ b/utility.lisp @@ -19,7 +19,7 @@ #:earlier-stamp #:stamps-earliest #:earliest-stamp #:later-stamp #:stamps-latest #:latest-stamp #:latest-stamp-f #:list-to-hash-set ;; hash-table - #:ensure-function #:sub-object ;; functions + #:ensure-function #:access-at #:access-at-count ;; functions #:call-function #:call-functions #:register-hook-function #:match-condition-p #:match-any-condition-p ;; conditions #:call-with-muffled-conditions #:with-muffled-conditions @@ -262,23 +262,37 @@ and EVAL that in a (FUNCTION ...) context." (let ((*package* (find-package package))) (read-from-string fun)))))))) -(defun* sub-object (object path) - "Given an OBJECT and a PATH, list of successive accessors, +(defun* access-at (object at) + "Given an OBJECT and an AT specifier, list of successive accessors, call each accessor on the result of the previous calls. An accessor may be an integer, meaning a call to ELT, -a function or symbol, meaning itself, -or a list of a function and arguments, interpreted as per ENSURE-FUNCTION. -As a degenerate case, the PATH may be an atom of a single such accessor +a keyword, meaning a call to GETF, +NIL, meaning identity, +a function or other symbol, meaning itself, +or a list of a function designator and arguments, interpreted as per ENSURE-FUNCTION. +As a degenerate case, the AT specifier may be an atom of a single such accessor instead of a list." (flet ((access (object accessor) (etypecase accessor + (function (funcall accessor object)) (integer (elt object accessor)) - ((or function symbol) (funcall accessor object)) + (keyword (getf object accessor)) + (null object) + (symbol (funcall accessor object)) (cons (funcall (ensure-function accessor) object))))) - (if (listp path) - (dolist (accessor path object) + (if (listp at) + (dolist (accessor at object) (setf object (access object accessor))) - (access object path)))) + (access object at)))) + +(defun* access-at-count (at) + "From an AT specification, extract a COUNT of maximum number + of sub-objects to read as per ACCESS-AT" + (cond + ((integerp at) + (1+ at)) + ((and (consp at) (integerp (first at))) + (1+ (first at))))) (defun* call-function (function-spec &rest arguments) (apply (ensure-function function-spec) arguments)) diff --git a/version.lisp-expr b/version.lisp-expr index 67a2d8eec5e2e7a70f0ca4d9755d2eae7f25e7b0..3fb32504d3d745fe1369a83544969f18b89e270b 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1 +1 @@ -"2.26.136" +"2.26.137"