diff --git a/asdf.lisp b/asdf.lisp index ea149edb0e1fcccd8bbabbf1904fd26a06aea6b9..cb2100a2437fc27a209e81637cb02e07b23a4ec6 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -484,7 +484,9 @@ pathnames." (last-comp (car (last components)))) (multiple-value-bind (relative components) (if (equal (first components) "") - (values :absolute (cdr components)) + (if (and (plusp (length s)) (eql (char s 0) #\/)) + (values :absolute (cdr components)) + (values :relative nil)) (values :relative components)) (cond ((equal last-comp "") @@ -786,12 +788,15 @@ actually-existing directory." (truename *default-pathname-defaults*))) (defmethod component-relative-pathname ((component module)) - (or (slot-value component 'relative-pathname) - (multiple-value-bind (relative path) - (component-name-to-pathname-components (component-name component) t) - (make-pathname - :directory `(,relative ,@path) - :host (pathname-host (component-parent-pathname component)))))) + (let ((specified-pathname (or (slot-value component 'relative-pathname) + (component-name component)))) + (if (pathnamep specified-pathname) + specified-pathname + (multiple-value-bind (relative path) + (component-name-to-pathname-components specified-pathname t) + (make-pathname + :directory `(,relative ,@path) + :host (pathname-host (component-parent-pathname component))))))) (defmethod component-pathname ((component component)) (merge-pathnames (component-relative-pathname component) diff --git a/asdf.texinfo b/asdf.texinfo index 34d059c3c05cf6c814dc486b37ae4342836c8d39..cb84f2c31ccd7b9d65c42233f0692e67dd147f6d 100644 --- a/asdf.texinfo +++ b/asdf.texinfo @@ -455,7 +455,7 @@ option := :components component-list | :default-component-class | :perform method-form | :explain method-form - | :output-files method-form + | :output-files method-form | :operation-done-p method-form | :depends-on ( {dependency-def}* ) | :serial [ t | nil ] @@ -1397,24 +1397,25 @@ ASDF bugs are tracked on launchpad: @url{https://launchpad.net/asdf}. @item ``I want to put my module's files at the top level. How do I do this?'' -By default, the files contained in an asdf module go in a subdirectory -with the same name as the module. However, this can be overridden by -adding a @code{:pathname} argument to the module description. For -example, here is how it is done in the spatial-trees ASDF system -definition: +By default, the files contained in an asdf module go +in a subdirectory with the same name as the module. +However, this can be overridden by adding a @code{:pathname} argument +to the module description. +For example, here is how it is done +in the spatial-trees ASDF system definition: @example (asdf:defsystem :spatial-trees :components ((:module base - :pathname #.(make-pathname :directory '(:relative)) + :pathname "" :components ((:file "package") (:file "basedefs" :depends-on ("package")) (:file "rectangles" :depends-on ("package")))) (:module tree-impls :depends-on (base) - :pathname #.(make-pathname :directory '(:relative)) + :pathname "" :components ((:file "r-trees") (:file "greene-trees" :depends-on ("r-trees")) @@ -1423,20 +1424,31 @@ definition: (:file "x-trees" :depends-on ("r-trees" "rstar-trees")))) (:module viz :depends-on (base) - :pathname #.(make-pathname :directory '(:relative)) + :pathname "" :components - ((:static-file "spatial-tree-viz" - :pathname #p"spatial-tree-viz.lisp"))) + ((:static-file "spatial-tree-viz.lisp"))) (:module tests :depends-on (base) - :pathname #.(make-pathname :directory '(:relative)) + :pathname "" :components - ((:static-file "spatial-tree-test" - :pathname #p"spatial-tree-test.lisp"))) + ((:static-file "spatial-tree-test.lisp"))) (:static-file "LICENCE") (:static-file "TODO"))) @end example +Note that the argument to @code{:pathname} can be either a pathname object or a string. +A pathname object can be constructed with the @code{#p"foo/bar/"} syntax, +but this is discouraged because the results are not portable. +It can only be portably constructed with such syntax as +@code{#.(make-pathname :directory '(:relative "foo" "bar"))}, +and similarly the current directory can only be portably specified as +@code{#.(make-pathname :directory '(:relative "foo" "bar"))}. +As of ASDF 1.623, however, you can portably use a string, +which will be parsed as a @code{/}-separated path from the current directory, +such that the empty string @code{""} denotes the current directory, and +@code{"foo/bar"} (no trailing @code{/} required in the case of modules) +portably denotes the same subdirectory as above. + All of the files in the @code{tree-impls} module are at the top level, instead of in a @code{tree-impls/} subdirectory. diff --git a/test/test-retry-loading-component-1.script b/test/test-retry-loading-component-1.script index 7495f747ce88f16047a57bd4dbf58afdcb513d3c..d0d0e228b2021b1c5424c6e0853107d745121cf1 100644 --- a/test/test-retry-loading-component-1.script +++ b/test/test-retry-loading-component-1.script @@ -10,29 +10,29 @@ ;(trace excl.osi:command-output) (defvar *caught-error* nil) (quit-on-error - (format t "trlc1 1~%") + ;;(format t "trlc1 1~%") (when (probe-file "try-reloading-dependency.asd") (asdf:run-shell-command "rm -f ~A" (namestring "try-reloading-dependency.asd"))) (setf asdf:*central-registry* '(*default-pathname-defaults*)) (setf asdf::*defined-systems* (asdf::make-defined-systems-table)) - (format t "trlc1 2~%") + ;;(format t "trlc1 2~%") (handler-bind ((error (lambda (c) (format t "~&Caught error ~s" c) (setf *caught-error* t) (asdf:run-shell-command "cp try-reloading-dependency.hidden try-reloading-dependency.asd") - (format t "trlc1 5~%") + ;;(format t "trlc1 5~%") (multiple-value-bind (name mode) (find-symbol (symbol-name 'retry) :asdf) (assert (eq mode :external) nil "Mode of ~s was not external" name) - (format t "trlc1 6~%") + ;;(format t "trlc1 6~%") (let ((restart (find-restart name c))) - (format t "trlc1 7~%") + ;;(format t "trlc1 7~%") (assert restart) (format t "~&restart: ~S~&" restart) (when restart (invoke-restart restart))))))) - (format t "trlc1 3~%") + ;;(format t "trlc1 3~%") (asdf:oos 'asdf:load-op 'try-reloading-1)) - (format t "trlc1 4~%") + ;;(format t "trlc1 4~%") (assert *caught-error*)) diff --git a/test/test-utilities.script b/test/test-utilities.script index a7216d5d20d5b9507603edb41da9b0efe89f01b4..9475d2b127b50e739fb40255e43c10497b8f8362 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -23,6 +23,18 @@ (make-pathname :name nil :type "bar" :directory '(:absolute "tmp")) (make-pathname :name "." :type nil :directory '(:absolute "tmp")) (make-pathname :name "." :type "" :directory '(:absolute "tmp"))))) +(assert (equal (multiple-value-list (component-name-to-pathname-components "" t)) + '(:relative nil nil))) +(assert (equal (multiple-value-list (component-name-to-pathname-components "" nil)) + '(:relative nil nil))) +(assert (equal (multiple-value-list (component-name-to-pathname-components "/" t)) + '(:absolute nil nil))) +(assert (equal (multiple-value-list (component-name-to-pathname-components "/" nil)) + '(:absolute nil nil))) +(assert (equal (multiple-value-list (component-name-to-pathname-components "/aa/ba" t)) + '(:absolute ("aa" "ba") nil))) +(assert (equal (multiple-value-list (component-name-to-pathname-components "/aa/ba" nil)) + '(:absolute ("aa") "ba"))) (assert (asdf::version-satisfies (asdf:asdf-version) (asdf:asdf-version))) (assert