Commit b45e9d68 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Portably interpret string arguments to :pathname specifications.

parent 7a55f292
......@@ -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)
......
......@@ -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.
......
......@@ -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*))
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment