Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Karsten Poeck
asdf
Commits
359ee3ad
Commit
359ee3ad
authored
Apr 03, 2017
by
Francois-Rene Rideau
Browse files
Merge branch 'preferred-asd'
parents
8a565d65
3135c195
Changes
8
Hide whitespace changes
Inline
Side-by-side
Makefile
View file @
359ee3ad
...
...
@@ -7,7 +7,7 @@
# your normal CL source registry. Otherwise, it will use local copies of
# everything.
system
:=
"asdf"
system
:=
"asdf"
webhome_private
:=
common-lisp.net:/project/asdf/public_html/
webhome_public
:=
"http://common-lisp.net/project/asdf/"
clnet_home
:=
"/project/asdf/public_html/"
...
...
doc/asdf.texinfo
View file @
359ee3ad
...
...
@@ -3642,8 +3642,13 @@ When looking in a tree, if one system is found, the search succeeds.
If multiple systems are found, the consequences are unspecified:
the search may succeed with any of the found systems,
or an error may be raised.
ASDF currently returns the first system found,
XCVB currently raised an error.
ASDF 3.2.1 or later returns the pathname whose normalized directory component
has the shortest length (as a list), and breaks ties by choosing the system
with the smallest @code
{
unix-namestring
}
when compared with @code
{
string<
}
.
Earlier versions of ASDF return ASDF return the first system found,
which is implementation-dependent, and may or may not be the pathname
with the smallest @code
{
unix-namestring
}
when compared with @code
{
string<
}
.
XCVB raises an error.
If none is found, the search continues.
Exclude statements specify patterns of subdirectories
...
...
source-registry.lisp
View file @
359ee3ad
...
...
@@ -302,6 +302,19 @@ after having found a .asd file? True by default.")
(
collect
(
list
directory
:recurse
recurse
:exclude
exclude
))))))
:test
'equal
:from-end
t
))
;; MAYBE: move this utility function to uiop/pathname and export it?
(
defun
pathname-directory-depth
(
p
)
(
length
(
normalize-pathname-directory-component
(
pathname-directory
p
))))
(
defun
preferred-source-path-p
(
x
y
)
"Return T iff X is to be preferred over Y as a source path"
(
let
((
lx
(
pathname-directory-depth
x
))
(
ly
(
pathname-directory-depth
y
)))
(
or
(
<
lx
ly
)
(
and
(
=
lx
ly
)
(
string<
(
namestring
x
)
(
namestring
y
))))))
;; Will read the configuration and initialize all internal variables.
(
defun
compute-source-registry
(
&optional
(
parameter
*source-registry-parameter*
)
(
registry
*source-registry*
))
...
...
@@ -320,18 +333,21 @@ after having found a .asd file? True by default.")
;; instead of (load-system 'foo)
(
string-downcase
name
)
name
)))
(
cond
((
gethash
name
registry
)
; already shadowed by something else
nil
)
((
gethash
name
h
)
; conflict at current level
(
when
*verbose-out*
(
warn
(
compatfmt
"~@<In source-registry entry ~A~@[/~*~] ~
found several entries for ~A - picking ~S over ~S~:>"
)
directory
recurse
name
(
gethash
name
h
)
asd
)))
(
t
(
setf
(
gethash
name
registry
)
asd
)
(
setf
(
gethash
name
h
)
asd
))))))
h
)))
(
unless
(
gethash
name
registry
)
; already shadowed by something else
(
if-let
(
old
(
gethash
name
h
))
;; If the name appears multiple times,
;; prefer the one with the shallowest directory,
;; or if they have same depth, compare unix-namestring with string<
(
multiple-value-bind
(
better
worse
)
(
if
(
preferred-source-path-p
asd
old
)
(
progn
(
setf
(
gethash
name
h
)
asd
)
(
values
asd
old
))
(
values
old
asd
))
(
when
*verbose-out*
(
warn
(
compatfmt
"~@<In source-registry entry ~A~@[/~*~] ~
found several entries for ~A - picking ~S over ~S~:>"
)
directory
recurse
name
better
worse
)))
(
setf
(
gethash
name
h
)
asd
))))))
(
maphash
#'
(
lambda
(
k
v
)
(
setf
(
gethash
k
registry
)
v
))
h
))))
(
values
))
(
defun
initialize-source-registry
(
&optional
(
parameter
*source-registry-parameter*
))
...
...
test/sources/a/which-asd2.asd
0 → 100644
View file @
359ee3ad
;; Used by test-source-registry. Should shadow other definitions.
(
defsystem
"which-asd2"
:version
"1"
)
test/sources/b/which-asd2.asd
0 → 100644
View file @
359ee3ad
;; Used by test-source-registry. Should be shadowed
(
defsystem
"which-asd2"
:version
"2"
)
test/sources/level1/which-asd.asd
0 → 100644
View file @
359ee3ad
;; Used by test-source-registry. Should be shadowed.
(
defsystem
"which-asd"
:version
"2"
)
test/sources/which-asd.asd
0 → 100644
View file @
359ee3ad
;; Used by test-source-registry. Should shadow other definitions.
(
defsystem
"which-asd"
:version
"1"
)
test/test-source-registry.script
0 → 100644
View file @
359ee3ad
;;; -*- Lisp -*-
(DBG "Testing that the source-registry prefers the path that is shorter and/or asciibetically earlier")
(setf *verbose-out* t)
(initialize-source-registry
`(:source-registry (:tree ,*test-directory*) :ignore-inherited-configuration))
(assert-pathname-equal
(system-source-directory "which-asd")
(subpathname *test-directory* "sources/"))
(assert-pathname-equal
(system-source-directory "which-asd2")
(subpathname *test-directory* "sources/a/"))
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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