Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
asdf
asdf
Commits
b45e9d68
Commit
b45e9d68
authored
Feb 22, 2010
by
Francois-Rene Rideau
Browse files
Portably interpret string arguments to :pathname specifications.
parent
7a55f292
Changes
4
Hide whitespace changes
Inline
Side-by-side
asdf.lisp
View file @
b45e9d68
...
...
@@ -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
)
...
...
asdf.texinfo
View file @
b45e9d68
...
...
@@ -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.
...
...
test/test-retry-loading-component-1.script
View file @
b45e9d68
...
...
@@ -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*))
test/test-utilities.script
View file @
b45e9d68
...
...
@@ -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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment