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
98127ec8
Commit
98127ec8
authored
Jan 18, 2013
by
Francois-Rene Rideau
Browse files
2.26.107: make logical pathnames work. Gah.
parent
139af5a4
Changes
9
Hide whitespace changes
Inline
Side-by-side
asdf.asd
View file @
98127ec8
...
...
@@ -15,7 +15,7 @@
:licence
"MIT"
:description
"Another System Definition Facility"
:long-description
"ASDF builds Common Lisp software organized into defined systems."
:version
"2.26.10
6
"
;; to be automatically updated by bin/bump-revision
:version
"2.26.10
7
"
;; to be automatically updated by bin/bump-revision
:depends-on
()
:components
((
:module
"build"
:components
((
:file
"asdf"
))))
:in-order-to
(
#+
asdf2.27
(
compile-op
(
monolithic-load-concatenated-source-op
generate-asdf
))))
...
...
defsystem.lisp
View file @
98127ec8
...
...
@@ -30,7 +30,7 @@
;; and merged into that DIRECTORY as per SUBPATHNAME.
;; If no absolute pathname was found, we return NIL.
(
check-type
pathname
(
or
null
string
pathname
))
(
or
(
and
(
pathnamep
pathname
)
(
absolute-pathname-p
pathname
))
(
or
(
and
(
pathnamep
pathname
)
(
absolute-pathname-p
pathname
)
(
resolve-symlinks*
pathname
))
(
let*
((
lisp-file-pathname
(
resolve-symlinks*
(
current-lisp-file-pathname
))))
(
when
(
absolute-pathname-p
lisp-file-pathname
)
(
subpathname
lisp-file-pathname
pathname
:type
:directory
)))))
...
...
@@ -169,7 +169,7 @@
;; we also need to remember it in a special variable *systems-being-defined*.
(
with-system-definitions
()
(
let*
((
name
(
coerce-name
name
))
(
source-file
(
if
sfp
source-file
(
current-lisp-file-pathname
)))
(
source-file
(
if
sfp
source-file
(
resolve-symlinks*
(
current-lisp-file-pathname
)))
)
(
registered
(
system-registered-p
name
))
(
registered!
(
if
registered
(
rplaca
registered
(
safe-file-write-date
source-file
))
...
...
find-system.lisp
View file @
98127ec8
...
...
@@ -133,9 +133,10 @@ called with an object of type asdf:system."
(
cleanup-system-definition-search-functions
)
(
defun*
search-for-system-definition
(
system
)
(
some
(
let
((
name
(
coerce-name
system
)))
#'
(
lambda
(
x
)
(
funcall
x
name
)))
(
cons
'find-system-if-being-defined
*system-definition-search-functions*
)))
(
with-pathname-defaults
()
(
some
(
let
((
name
(
coerce-name
system
)))
#'
(
lambda
(
x
)
(
funcall
x
name
)))
(
cons
'find-system-if-being-defined
*system-definition-search-functions*
))))
(
defvar
*central-registry*
nil
"A list of 'system directory designators' ASDF uses to find systems.
...
...
@@ -155,14 +156,14 @@ Going forward, we recommend new users should be using the source-registry.
(
defun*
probe-asd
(
name
defaults
)
(
block
nil
(
when
(
directory-pathname-p
defaults
)
(
let*
((
file
(
probe-file*
(
subpathname
defaults
(
strcat
name
".
asd"
))))
)
(
let*
((
file
(
probe-file*
(
subpathname
defaults
name
:type
"
asd"
))))
(
when
file
(
return
file
)))
#-
(
or
clisp
genera
)
; clisp doesn't need it, plain genera doesn't have read-sequence(!)
(
when
(
os-windows-p
)
(
let
((
shortcut
(
make-pathname
:defaults
defaults
:version
:newest
:case
:local
:defaults
defaults
:case
:local
:name
(
strcat
name
".asd"
)
:type
"lnk"
)))
(
when
(
probe-file*
shortcut
)
...
...
@@ -279,16 +280,13 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(
pathname
(
or
(
and
(
typep
found
'
(
or
pathname
string
))
(
pathname
found
))
(
and
found-system
(
system-source-file
found-system
))
(
and
previous
(
system-source-file
previous
))))
(
pathname
(
ensure-pathname
(
resolve-symlinks*
pathname
)
:want-absolute
t
))
(
foundp
(
and
(
or
found-system
pathname
previous
)
t
)))
(
check-type
found
(
or
null
pathname
system
))
(
when
foundp
(
setf
pathname
(
resolve-symlinks*
pathname
))
(
when
(
and
pathname
(
not
(
absolute-pathname-p
pathname
)))
(
setf
pathname
(
ensure-pathname-absolute
pathname
))
(
when
found-system
(
setf
(
system-source-file
found-system
)
pathname
)))
(
when
(
and
previous
(
not
(
#-
cormanlisp
equal
#+
cormanlisp
equalp
(
system-source-file
previous
)
pathname
)))
(
when
(
and
pathname
found-system
)
(
setf
(
system-source-file
found-system
)
pathname
))
(
when
(
and
previous
(
not
(
pathname-equal
(
system-source-file
previous
)
pathname
)))
(
setf
(
system-source-file
previous
)
pathname
)
(
setf
previous-time
nil
))
(
values
foundp
found-system
pathname
previous
previous-time
))))
...
...
@@ -302,9 +300,11 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(
declare
(
ignore
foundp
))
(
when
(
and
found-system
(
not
previous
))
(
register-system
found-system
))
(
unless
(
and
(
equal
pathname
(
and
previous
(
system-source-file
previous
)))
(
stamp<=
(
safe-file-write-date
pathname
)
previous-time
))
;; only load when it's a different pathname, or newer file content
(
when
(
and
pathname
(
not
(
and
previous
(
pathname-equal
pathname
(
system-source-file
previous
))
(
stamp<=
(
safe-file-write-date
pathname
)
previous-time
))))
;; only load when it's a pathname that is different or has newer content
(
load-sysdef
name
pathname
))
(
let
((
in-memory
(
system-registered-p
name
)))
; try again after loading from disk if needed
(
return
...
...
header.lisp
View file @
98127ec8
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
;;; This is ASDF 2.26.10
6
: Another System Definition Facility.
;;; This is ASDF 2.26.10
7
: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
...
...
pathname.lisp
View file @
98127ec8
...
...
@@ -9,6 +9,7 @@
#:*resolve-symlinks*
;; Making and merging pathnames, portably
#:normalize-pathname-directory-component
#:denormalize-pathname-directory-component
#:pathname-equal
#:merge-pathname-directory-components
#:make-pathname*
#:*unspecific-pathname-type*
#:make-pathname-component-logical
#:make-pathname-logical
#:merge-pathnames*
...
...
@@ -200,6 +201,27 @@ by default *DEFAULT-PATHNAME-DEFAULTS*, which cannot be NIL."
;;; Some pathname predicates
(
defun*
pathname-equal
(
p1
p2
)
(
when
(
stringp
p1
)
(
setf
p1
(
pathname
p1
)))
(
when
(
stringp
p2
)
(
setf
p2
(
pathname
p2
)))
(
flet
((
normalize-component
(
x
)
(
and
(
not
(
member
x
'
(
nil
:unspecific
:newest
(
:relative
))
:test
'equal
))
x
)))
(
macrolet
((
=?
(
&rest
accessors
)
(
flet
((
frob
(
x
)
(
reduce
'list
(
cons
'normalize-component
accessors
)
:initial-value
x
:from-end
t
)))
`
(
equal
,
(
frob
'p1
)
,
(
frob
'p2
)))))
(
or
(
and
(
null
p1
)
(
null
2
))
(
and
(
pathnamep
p1
)
(
pathnamep
p2
)
(
or
(
equal
p1
p2
)
(
=?
pathname-host
)
(
=?
pathname-device
)
(
=?
normalize-pathname-directory-component
pathname-directory
)
(
=?
pathname-name
)
(
=?
pathname-type
)
(
=?
pathname-version
)))))))
(
defun*
absolute-pathname-p
(
pathspec
)
"If PATHSPEC is a pathname or namestring object that parses as a pathname
possessing an :ABSOLUTE directory component, return the (parsed) pathname.
...
...
@@ -853,8 +875,11 @@ For the latter case, we ought pick random suffix and atomically open it."
`
(
call-with-staging-pathname
,
pathname-value
#'
(
lambda
(
,
pathname-var
)
,@
body
)))
;;; Basic pathnames
(
defun*
logical-pathname-p
(
x
)
(
typep
x
'logical-pathname
))
(
defun*
physical-pathname-p
(
x
)
(
and
(
pathnamep
x
)
(
not
(
typep
x
'
logical-pathname
))))
(
and
(
pathnamep
x
)
(
not
(
logical-pathname
-p
x
))))
(
defun*
sane-physical-pathname
(
&key
defaults
(
keep
t
)
fallback
want-existing
)
(
flet
((
sanitize
(
x
)
...
...
@@ -1049,7 +1074,7 @@ TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible."
:ensure-directory
ensure-directory
:want-relative
want-relative
))))
(
check
want-pathname
(
pathnamep
p
)
"Expected a pathname, not NIL"
)
(
unless
pathname
(
return
NIL
))
(
check
want-logical
(
typep
p
'
logical-pathname
)
"Expected a logical pathname"
)
(
check
want-logical
(
logical-pathname
-p
p
)
"Expected a logical pathname"
)
(
check
want-physical
(
physical-pathname-p
p
)
"Expected a physical pathname"
)
(
transform
ensure-physical
()
(
translate-logical-pathname
p
))
(
check
ensure-physical
(
physical-pathname-p
p
)
"Could not translate to a physical pathname"
)
...
...
source-registry.lisp
View file @
98127ec8
...
...
@@ -51,7 +51,7 @@ system names to pathnames of .asd files")
(
register-clear-configuration-hook
'clear-source-registry
)
(
defparameter
*wild-asd*
(
make-pathname*
:directory
nil
:name
*wild*
:type
"asd"
:version
:newest
))
(
make-pathname*
:directory
nil
:name
*wild*
:type
"asd"
))
(
defun*
directory-asd-files
(
directory
)
(
directory-files
directory
*wild-asd*
))
...
...
test/test-logical-pathname.script
View file @
98127ec8
...
...
@@ -50,6 +50,9 @@
;; and it tries to load ASDF from a logical-pathname.
'(:source-registry (:tree #p"ASDF:test;")
:ignore-inherited-configuration))
(load-system :test-logical-pathname :force t))
(load-system :test-logical-pathname :force t)
(let ((sys (find-system :test-logical-pathname)))
(assert (logical-pathname-p (component-pathname sys)))
(assert (logical-pathname-p (system-source-file sys)))))
(DBG "Done"))
upgrade.lisp
View file @
98127ec8
...
...
@@ -45,7 +45,7 @@
;; "2.345.6" would be a development version in the official upstream
;; "2.345.0.7" would be your seventh local modification of official release 2.345
;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
(
asdf-version
"2.26.10
6
"
)
(
asdf-version
"2.26.10
7
"
)
(
existing-asdf
(
find-class
(
find-symbol*
:component
:asdf
nil
)
nil
))
(
existing-version
*asdf-version*
)
(
already-there
(
equal
asdf-version
existing-version
)))
...
...
version.lisp-expr
View file @
98127ec8
"2.26.10
6
"
"2.26.10
7
"
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