Loading asdf.lisp +54 −14 Original line number Diff line number Diff line Loading @@ -2364,6 +2364,16 @@ with a different configuration, so the configuration would be re-read then." (flet ((componentp (c) (typep c '(or string pathname keyword)))) (or (null x) (componentp x) (and (consp x) (every #'componentp x))))) (defun location-function-p (x) (and (consp x) (length=n-p x 2) (or (and (equal (first x) :function) (typep (second x) 'symbol)) (and (equal (first x) 'lambda) (cddr x) (length=n-p (second x) 2))))) (defun validate-output-translations-directive (directive) (unless (or (member directive '(:inherit-configuration Loading @@ -2374,7 +2384,8 @@ with a different configuration, so the configuration would be re-read then." (or (and (eq (first directive) :include) (typep (second directive) '(or string pathname null))) (and (location-designator-p (first directive)) (location-designator-p (second directive))))) (or (location-designator-p (second directive)) (location-function-p (second directive)))))) (and (length=n-p directive 1) (location-designator-p (first directive)))))) (error "Invalid directive ~S~%" directive)) Loading Loading @@ -2447,6 +2458,8 @@ with a different configuration, so the configuration would be re-read then." #+sbcl (,(getenv "SBCL_HOME") ()) #+ecl (,(translate-logical-pathname "SYS:**;*.*") ()) ; only needed if LPNs are resolved manually. #+clozure (,(wilden (ccl::ccl-directory)) ()) ; not needed: no precompiled ASDF system #+abcl (#p"jar:file:/**/*.jar!/**/*.*" (:function translate-jar-pathname)) #+abcl (#p"/:jar:file/**/*.*" (:user-cache #p"**/*.*")) ;; All-import, here is where we want user stuff to be: :inherit-configuration ;; If we want to enable the user cache by default, here would be the place: Loading Loading @@ -2512,11 +2525,17 @@ with a different configuration, so the configuration would be re-read then." (when dst (process-output-translations (pathname dst) :inherit nil :collect collect)) (when src (let* ((trusrc (truenamize (resolve-location src t))) (trudst (if dst (resolve-location dst t) trusrc)) (let ((trusrc (truenamize (resolve-location src t)))) (if (location-function-p dst) (funcall collect (list trusrc (if (symbolp (second dst)) (fdefinition (second dst)) (eval (second dst))))) (let* ((trudst (if dst (resolve-location dst t) trusrc)) (wilddst (make-pathname :name :wild :type :wild :defaults trudst))) (funcall collect (list wilddst wilddst)) (funcall collect (list trusrc trudst)))))))) (funcall collect (list trusrc trudst)))))))))) (defun compute-output-translations (&optional parameter) "read the configuration, return it" Loading Loading @@ -2552,11 +2571,14 @@ effectively disabling the output translation facility." path) ((or pathname string) (ensure-output-translations) (setf path (truenamize path)) (loop :for (source destination) :in (car *output-translations*) :when (pathname-match-p path source) :return (translate-pathname path source destination) :finally (return path))))) (loop :with p = (truenamize path) :for (source destination) :in (car *output-translations*) :when (pathname-match-p p source) :return (if (functionp destination) (funcall destination p source) (translate-pathname p source destination)) :finally (return p))))) (defmethod output-files :around (operation component) "Translate output files, unless asked not to" Loading @@ -2574,6 +2596,18 @@ effectively disabling the output translation facility." (truenamize (lispize-pathname input-file)) keys))) (defun translate-jar-pathname (source wildcard) (declare (ignore wildcard)) (let ((root (apply-output-translations (concatenate 'string "/:jar:file/" (namestring (first (pathname-device source)))))) (entry (make-pathname :directory (pathname-directory source) :name (pathname-name source) :type (pathname-type source)))) (concatenate 'string (namestring root) (namestring entry)))) ;;;; ----------------------------------------------------------------- ;;;; Compatibility mode for ASDF-Binary-Locations Loading Loading @@ -2950,10 +2984,15 @@ with a different configuration, so the configuration would be re-read then." ;;;; ----------------------------------------------------------------- ;;;; SBCL and ClozureCL hook into REQUIRE ;;;; #+(or sbcl clozure) #+(or sbcl clozure abcl) (progn (defun module-provide-asdf (name) (handler-bind ((style-warning #'muffle-warning)) (handler-bind ((style-warning #'muffle-warning) (missing-component (constantly nil)) (error (lambda (e) (format *error-output* "ASDF could not load ~A because ~A.~%" name e)))) (let* ((*verbose-out* (make-broadcast-stream)) (system (asdf:find-system name nil))) (when system Loading @@ -2961,7 +3000,8 @@ with a different configuration, so the configuration would be re-read then." t)))) (pushnew 'module-provide-asdf #+sbcl sb-ext:*module-provider-functions* #+clozure ccl::*module-provider-functions*)) #+clozure ccl::*module-provider-functions* #+abcl sys::*module-provider-functions*)) ;;;; ------------------------------------------------------------------------- ;;;; Cleanups after hot-upgrade. Loading doc/asdf.texinfo +25 −5 Original line number Diff line number Diff line Loading @@ -1828,7 +1828,7 @@ The specified functions are exported from your build system's package. Thus for ASDF the corresponding functions are in package ASDF, and for XCVB the corresponding functions are in package XCVB. @defun initialize-source-registry PARAMETER @defun initialize-source-registry @&optional PARAMETER will read the configuration and initialize all internal variables. You may extend or override configuration from the environment and configuration files Loading @@ -1851,7 +1851,7 @@ and for XCVB the corresponding functions are in package XCVB. where to look for systems not yet defined. @end defun @defun ensure-source-registry PARAMETER @defun ensure-source-registry @&optional PARAMETER checks whether a source registry has been initialized. If not, initialize it with the given @var{PARAMETER}. @end defun Loading Loading @@ -2120,6 +2120,8 @@ DIRECTIVE := ;; add a single directory to be scanned (no recursion) (DIRECTORY-DESIGNATOR DIRECTORY-DESIGNATOR) ;; use a function to return the translation of a directory designator (DIRECTORY-DESIGNATOR (:function TRANSLATION-FUNCTION)) DIRECTORY-DESIGNATOR := ABSOLUTE-COMPONENT-DESIGNATOR | Loading @@ -2143,6 +2145,13 @@ RELATIVE-COMPONENT-DESIGNATOR := :CURRENT-DIRECTORY | ;; all components of the current directory, without the :absolute :UID | ;; current UID -- not available on Windows :USER ;; current USER name -- NOT IMPLEMENTED(!) TRANSLATION-FUNCTION := SYMBOL | ;; symbol of a function that takes two arguments, ;; the pathname to be translated and the matching DIRECTORY-DESIGNATOR LAMBDA ;; A form which evalutates to a function taking two arguments consisting of ;; the pathname to be translated and the matching DIRECTORY-DESIGNATOR @end verbatim Relative components better be either relative Loading @@ -2161,6 +2170,17 @@ to anything but themselves (same as if the second designator was the same as the @code{:include} statements cause the search to recurse with the path specifications from the file specified. If the @code{translate-pathname} mechanism cannot achieve a desired translation, the user may provide a function which provides the required algorithim. Such a translation function is specified by supplying a list as the second @code{directory-designator} whose first element is the keyword @code{:function}, and whose second element is either a symbol which designates a function or a lambda expression. The function designated by the second argument must take two arguments, the first being the pathname of the source file, the second being the wildcard that was matched. The result of the function invocation should be the translated pathname. An @code{:inherit-configuration} statement cause the search to recurse with the path specifications from the next configuration. @xref{Controlling where ASDF saves compiled files,,Configurations}, above. Loading Loading @@ -2265,7 +2285,7 @@ To explicitly flush any information cached by the system, use the API below. The specified functions are exported from package ASDF. @defun initialize-output-translations PARAMETER @defun initialize-output-translations @&optional PARAMETER will read the configuration and initialize all internal variables. You may extend or override configuration from the environment and configuration files Loading Loading @@ -2294,7 +2314,7 @@ The specified functions are exported from package ASDF. where to look for systems not yet defined. @end defun @defun ensure-output-translations PARAMETER @defun ensure-output-translations @&optional PARAMETER checks whether output translations have been initialized. If not, initialize them with the given @var{PARAMETER}. This function will be called before any attempt to operate on a system. Loading test/run-tests.sh +1 −0 Original line number Diff line number Diff line Loading @@ -153,6 +153,7 @@ case "$lisp" in eval="-eval" ;; abcl) command="${ABCL:-abcl}" flags="--noinit --noinform" eval="--eval" ;; *) echo "Unsupported lisp: $1" >&2 Loading Loading
asdf.lisp +54 −14 Original line number Diff line number Diff line Loading @@ -2364,6 +2364,16 @@ with a different configuration, so the configuration would be re-read then." (flet ((componentp (c) (typep c '(or string pathname keyword)))) (or (null x) (componentp x) (and (consp x) (every #'componentp x))))) (defun location-function-p (x) (and (consp x) (length=n-p x 2) (or (and (equal (first x) :function) (typep (second x) 'symbol)) (and (equal (first x) 'lambda) (cddr x) (length=n-p (second x) 2))))) (defun validate-output-translations-directive (directive) (unless (or (member directive '(:inherit-configuration Loading @@ -2374,7 +2384,8 @@ with a different configuration, so the configuration would be re-read then." (or (and (eq (first directive) :include) (typep (second directive) '(or string pathname null))) (and (location-designator-p (first directive)) (location-designator-p (second directive))))) (or (location-designator-p (second directive)) (location-function-p (second directive)))))) (and (length=n-p directive 1) (location-designator-p (first directive)))))) (error "Invalid directive ~S~%" directive)) Loading Loading @@ -2447,6 +2458,8 @@ with a different configuration, so the configuration would be re-read then." #+sbcl (,(getenv "SBCL_HOME") ()) #+ecl (,(translate-logical-pathname "SYS:**;*.*") ()) ; only needed if LPNs are resolved manually. #+clozure (,(wilden (ccl::ccl-directory)) ()) ; not needed: no precompiled ASDF system #+abcl (#p"jar:file:/**/*.jar!/**/*.*" (:function translate-jar-pathname)) #+abcl (#p"/:jar:file/**/*.*" (:user-cache #p"**/*.*")) ;; All-import, here is where we want user stuff to be: :inherit-configuration ;; If we want to enable the user cache by default, here would be the place: Loading Loading @@ -2512,11 +2525,17 @@ with a different configuration, so the configuration would be re-read then." (when dst (process-output-translations (pathname dst) :inherit nil :collect collect)) (when src (let* ((trusrc (truenamize (resolve-location src t))) (trudst (if dst (resolve-location dst t) trusrc)) (let ((trusrc (truenamize (resolve-location src t)))) (if (location-function-p dst) (funcall collect (list trusrc (if (symbolp (second dst)) (fdefinition (second dst)) (eval (second dst))))) (let* ((trudst (if dst (resolve-location dst t) trusrc)) (wilddst (make-pathname :name :wild :type :wild :defaults trudst))) (funcall collect (list wilddst wilddst)) (funcall collect (list trusrc trudst)))))))) (funcall collect (list trusrc trudst)))))))))) (defun compute-output-translations (&optional parameter) "read the configuration, return it" Loading Loading @@ -2552,11 +2571,14 @@ effectively disabling the output translation facility." path) ((or pathname string) (ensure-output-translations) (setf path (truenamize path)) (loop :for (source destination) :in (car *output-translations*) :when (pathname-match-p path source) :return (translate-pathname path source destination) :finally (return path))))) (loop :with p = (truenamize path) :for (source destination) :in (car *output-translations*) :when (pathname-match-p p source) :return (if (functionp destination) (funcall destination p source) (translate-pathname p source destination)) :finally (return p))))) (defmethod output-files :around (operation component) "Translate output files, unless asked not to" Loading @@ -2574,6 +2596,18 @@ effectively disabling the output translation facility." (truenamize (lispize-pathname input-file)) keys))) (defun translate-jar-pathname (source wildcard) (declare (ignore wildcard)) (let ((root (apply-output-translations (concatenate 'string "/:jar:file/" (namestring (first (pathname-device source)))))) (entry (make-pathname :directory (pathname-directory source) :name (pathname-name source) :type (pathname-type source)))) (concatenate 'string (namestring root) (namestring entry)))) ;;;; ----------------------------------------------------------------- ;;;; Compatibility mode for ASDF-Binary-Locations Loading Loading @@ -2950,10 +2984,15 @@ with a different configuration, so the configuration would be re-read then." ;;;; ----------------------------------------------------------------- ;;;; SBCL and ClozureCL hook into REQUIRE ;;;; #+(or sbcl clozure) #+(or sbcl clozure abcl) (progn (defun module-provide-asdf (name) (handler-bind ((style-warning #'muffle-warning)) (handler-bind ((style-warning #'muffle-warning) (missing-component (constantly nil)) (error (lambda (e) (format *error-output* "ASDF could not load ~A because ~A.~%" name e)))) (let* ((*verbose-out* (make-broadcast-stream)) (system (asdf:find-system name nil))) (when system Loading @@ -2961,7 +3000,8 @@ with a different configuration, so the configuration would be re-read then." t)))) (pushnew 'module-provide-asdf #+sbcl sb-ext:*module-provider-functions* #+clozure ccl::*module-provider-functions*)) #+clozure ccl::*module-provider-functions* #+abcl sys::*module-provider-functions*)) ;;;; ------------------------------------------------------------------------- ;;;; Cleanups after hot-upgrade. Loading
doc/asdf.texinfo +25 −5 Original line number Diff line number Diff line Loading @@ -1828,7 +1828,7 @@ The specified functions are exported from your build system's package. Thus for ASDF the corresponding functions are in package ASDF, and for XCVB the corresponding functions are in package XCVB. @defun initialize-source-registry PARAMETER @defun initialize-source-registry @&optional PARAMETER will read the configuration and initialize all internal variables. You may extend or override configuration from the environment and configuration files Loading @@ -1851,7 +1851,7 @@ and for XCVB the corresponding functions are in package XCVB. where to look for systems not yet defined. @end defun @defun ensure-source-registry PARAMETER @defun ensure-source-registry @&optional PARAMETER checks whether a source registry has been initialized. If not, initialize it with the given @var{PARAMETER}. @end defun Loading Loading @@ -2120,6 +2120,8 @@ DIRECTIVE := ;; add a single directory to be scanned (no recursion) (DIRECTORY-DESIGNATOR DIRECTORY-DESIGNATOR) ;; use a function to return the translation of a directory designator (DIRECTORY-DESIGNATOR (:function TRANSLATION-FUNCTION)) DIRECTORY-DESIGNATOR := ABSOLUTE-COMPONENT-DESIGNATOR | Loading @@ -2143,6 +2145,13 @@ RELATIVE-COMPONENT-DESIGNATOR := :CURRENT-DIRECTORY | ;; all components of the current directory, without the :absolute :UID | ;; current UID -- not available on Windows :USER ;; current USER name -- NOT IMPLEMENTED(!) TRANSLATION-FUNCTION := SYMBOL | ;; symbol of a function that takes two arguments, ;; the pathname to be translated and the matching DIRECTORY-DESIGNATOR LAMBDA ;; A form which evalutates to a function taking two arguments consisting of ;; the pathname to be translated and the matching DIRECTORY-DESIGNATOR @end verbatim Relative components better be either relative Loading @@ -2161,6 +2170,17 @@ to anything but themselves (same as if the second designator was the same as the @code{:include} statements cause the search to recurse with the path specifications from the file specified. If the @code{translate-pathname} mechanism cannot achieve a desired translation, the user may provide a function which provides the required algorithim. Such a translation function is specified by supplying a list as the second @code{directory-designator} whose first element is the keyword @code{:function}, and whose second element is either a symbol which designates a function or a lambda expression. The function designated by the second argument must take two arguments, the first being the pathname of the source file, the second being the wildcard that was matched. The result of the function invocation should be the translated pathname. An @code{:inherit-configuration} statement cause the search to recurse with the path specifications from the next configuration. @xref{Controlling where ASDF saves compiled files,,Configurations}, above. Loading Loading @@ -2265,7 +2285,7 @@ To explicitly flush any information cached by the system, use the API below. The specified functions are exported from package ASDF. @defun initialize-output-translations PARAMETER @defun initialize-output-translations @&optional PARAMETER will read the configuration and initialize all internal variables. You may extend or override configuration from the environment and configuration files Loading Loading @@ -2294,7 +2314,7 @@ The specified functions are exported from package ASDF. where to look for systems not yet defined. @end defun @defun ensure-output-translations PARAMETER @defun ensure-output-translations @&optional PARAMETER checks whether output translations have been initialized. If not, initialize them with the given @var{PARAMETER}. This function will be called before any attempt to operate on a system. Loading
test/run-tests.sh +1 −0 Original line number Diff line number Diff line Loading @@ -153,6 +153,7 @@ case "$lisp" in eval="-eval" ;; abcl) command="${ABCL:-abcl}" flags="--noinit --noinform" eval="--eval" ;; *) echo "Unsupported lisp: $1" >&2 Loading