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
5a520005
Commit
5a520005
authored
Feb 26, 2013
by
Francois-Rene Rideau
Browse files
2.31.1: require-system, a class for systems that use (REQUIRE ...)
Based on a patch by Stelian Ionescu.
parent
029ebf87
Changes
11
Hide whitespace changes
Inline
Side-by-side
TODO
View file @
5a520005
* have a mode to explain WHY a module needs to be recompiled.
* have a better defsystem form verifier - see lp#1007335
* have a function verify-strict-asd that can verify a asd is pure lp#541562
Then if it passes, use load-strict-asd.
...
...
asdf.asd
View file @
5a520005
...
...
@@ -74,7 +74,7 @@
:licence
"MIT"
:description
"Another System Definition Facility"
:long-description
"ASDF builds Common Lisp software organized into defined systems."
:version
"2.31"
;; to be automatically updated by make bump-version
:version
"2.31
.1
"
;; to be automatically updated by make bump-version
:depends-on
()
#+
asdf3
:encoding
#+
asdf3
:utf-8
;; For most purposes, asdf itself specially counts as a builtin system.
...
...
cache.lisp
View file @
5a520005
...
...
@@ -22,13 +22,13 @@
(
setf
(
gethash
key
*asdf-cache*
)
value-list
)
value-list
)))
(
defun
consult-asdf-cache
(
key
thunk
)
(
defun
consult-asdf-cache
(
key
&optional
thunk
)
(
if
*asdf-cache*
(
multiple-value-bind
(
results
foundp
)
(
gethash
key
*asdf-cache*
)
(
if
foundp
(
apply
'values
results
)
(
set-asdf-cache-entry
key
(
multiple-value-list
(
fun
call
thunk
)))))
(
fun
call
thunk
)))
(
set-asdf-cache-entry
key
(
multiple-value-list
(
call
-function
thunk
)))))
(
call
-function
thunk
)))
(
defmacro
do-asdf-cache
(
key
&body
body
)
`
(
consult-asdf-cache
,
key
#'
(
lambda
()
,@
body
)))
...
...
header.lisp
View file @
5a520005
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.31: Another System Definition Facility.
;;; This is ASDF 2.31
.1
: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
...
...
operate.lisp
View file @
5a520005
...
...
@@ -140,18 +140,48 @@ for how to load or compile stuff")
(
defun
require-system
(
s
&rest
keys
&key
&allow-other-keys
)
(
apply
'load-system
s
:force-not
(
already-loaded-systems
)
keys
))
(
defvar
*modules-being-required*
nil
)
(
defclass
require-system
(
system
)
((
module
:initarg
:module
:initform
nil
:accessor
required-module
)))
(
defmethod
perform
((
o
compile-op
)
(
c
require-system
))
(
declare
(
ignorable
o
c
))
nil
)
(
defmethod
perform
((
o
load-op
)
(
s
require-system
))
(
declare
(
ignorable
o
))
(
let*
((
module
(
or
(
required-module
s
)
(
coerce-name
s
)))
(
*modules-being-required*
(
cons
module
*modules-being-required*
)))
(
assert
(
null
(
component-children
s
)))
(
require
module
)))
(
defmethod
resolve-dependency-combination
(
component
(
combinator
(
eql
:require
))
arguments
)
(
declare
(
ignorable
component
combinator
))
(
unless
(
length=n-p
arguments
1
)
(
error
(
compatfmt
"~@<Bad dependency ~S for ~S. ~S takes only one argument~@:>"
)
(
cons
combinator
arguments
)
component
combinator
))
(
let*
((
module
(
car
arguments
))
(
name
(
string-downcase
module
)))
(
assert
module
)
(
make-instance
'require-system
:name
name
)))
(
defun
module-provide-asdf
(
name
)
(
handler-bind
((
style-warning
#'
muffle-warning
)
(
missing-component
(
constantly
nil
))
(
error
#'
(
lambda
(
e
)
(
format
*error-output*
(
compatfmt
"~@<ASDF could not load ~(~A~) because ~A.~@:>~%"
)
name
e
))))
(
let
((
*verbose-out*
(
make-broadcast-stream
))
(
system
(
find-system
(
string-downcase
name
)
nil
)))
(
when
system
(
require-system
system
:verbose
nil
)
t
)))))
(
let
((
module
(
string-downcase
name
)))
(
unless
(
member
module
*modules-being-required*
:test
'equal
)
(
let
((
*modules-being-required*
(
cons
module
*modules-being-required*
))
#+
sbcl
(
sb-impl::*requiring*
(
remove
module
sb-impl::*requiring*
:test
'equal
)))
(
handler-bind
((
style-warning
#'
muffle-warning
)
(
missing-component
(
constantly
nil
))
(
error
#'
(
lambda
(
e
)
(
format
*error-output*
(
compatfmt
"~@<ASDF could not load ~(~A~) because ~A.~@:>~%"
)
name
e
))))
(
let
((
*verbose-out*
(
make-broadcast-stream
)))
(
let
((
system
(
find-system
module
nil
)))
(
when
system
(
require-system
system
:verbose
nil
)
t
)))))))))
;;;; Some upgrade magic
...
...
output-translations.lisp
View file @
5a520005
...
...
@@ -263,27 +263,27 @@ effectively disabling the output translation facility."
(
initialize-output-translations
)))
(
defun*
(
apply-output-translations
)
(
path
)
#+
cormanlisp
(
resolve-symlinks*
path
)
#-
cormanlisp
(
etypecase
path
(
logical-pathname
path
)
((
or
pathname
string
)
(
ensure-output-translations
)
(
loop*
:with
p
=
(
resolve-symlinks*
path
)
:for
(
source
destination
)
:in
(
car
*output-translations*
)
:for
root
=
(
when
(
or
(
eq
source
t
)
(
and
(
pathnamep
source
)
(
not
(
absolute-pathname-p
source
))))
(
pathname-root
p
))
:for
absolute-source
=
(
cond
((
eq
source
t
)
(
wilden
root
))
(
root
(
merge-pathnames*
source
root
))
(
t
source
))
:when
(
or
(
eq
source
t
)
(
pathname-match-p
p
absolute-source
))
:return
(
translate-pathname*
p
absolute-source
destination
root
source
)
:finally
(
return
p
)))))
(
etypecase
path
(
logical-pathname
path
)
((
or
pathname
string
)
(
ensure-output-translations
)
(
loop*
:with
p
=
(
resolve-symlinks*
path
)
:for
(
source
destination
)
:in
(
car
*output-translations*
)
:for
root
=
(
when
(
or
(
eq
source
t
)
(
and
(
pathnamep
source
)
(
not
(
absolute-pathname-p
source
))))
(
pathname-root
p
))
:for
absolute-source
=
(
cond
((
eq
source
t
)
(
wilden
root
))
(
root
(
merge-pathnames*
source
root
))
(
t
source
))
:when
(
or
(
eq
source
t
)
(
pathname-match-p
p
absolute-source
))
:return
(
translate-pathname*
p
absolute-source
destination
root
source
)
:finally
(
return
p
)))))
;; Hook into asdf/driver's output-translation mechanism
#-
cormanlisp
(
setf
*output-translation-function*
'apply-output-translations
)
#+
abcl
...
...
plan.lisp
View file @
5a520005
...
...
@@ -176,7 +176,8 @@ the action of OPERATION on COMPONENT in the PLAN"))
:do
(
loop
:with
dep-o
=
(
find-operation
operation
dep-o-spec
)
:for
dep-c-spec
:in
dep-c-specs
:for
dep-c
=
(
resolve-dependency-spec
component
dep-c-spec
)
:do
(
funcall
fun
dep-o
dep-c
))))
:when
(
and
dep-o
dep-c
)
:do
(
funcall
fun
dep-o
dep-c
))))
(
defun
reduce-direct-dependencies
(
operation
component
combinator
seed
)
(
map-direct-dependencies
...
...
test/test-asdf.asd
View file @
5a520005
...
...
@@ -30,6 +30,7 @@
:depends-on
((
:version
:test-asdf/test9-2
"2.0"
)))
(
defsystem
:test-asdf/test-module-depend
:depends-on
(
#+
sbcl
(
:require
:sb-posix
))
:components
((
:file
"file1"
)
(
:module
"quux"
...
...
test/test-encodings.script
View file @
5a520005
...
...
@@ -40,8 +40,10 @@
(leave-test "No Unicode support to test on this lisp implementation" 0)
#+abcl
(when (version< (lisp-implementation-version) "1.1.2")
(leave-test "Your old ABCL is known to fail this test script, so skipping it." 0))
(let ((version (lisp-implementation-version))
(version-nums (subseq version 0 (position-if-not (lambda (x) (find x "0123456789.")) version))))
(when (version< version-nums "1.1.2")
(leave-test "Your old ABCL is known to fail this test script, so skipping it." 0)))
(with-encoding-test (:utf-8)
(def-test-system :test-encoding-explicit-u8
...
...
upgrade.lisp
View file @
5a520005
...
...
@@ -52,7 +52,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
;; "3.4.5.67" would be a development version in the official upstream of 3.4.5.
;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
(
asdf-version
"2.31"
)
(
asdf-version
"2.31
.1
"
)
(
existing-version
(
asdf-version
)))
(
setf
*asdf-version*
asdf-version
)
(
when
(
and
existing-version
(
not
(
equal
asdf-version
existing-version
)))
...
...
version.lisp-expr
View file @
5a520005
"2.31"
"2.31
.1
"
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