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
5f6aabab
Commit
5f6aabab
authored
Jan 18, 2013
by
Francois-Rene Rideau
Browse files
2.26.116: Avoid stepping on symbols used by ASDF 2.26 and earlier
unless we're backward compatible.
parent
6f520a1e
Changes
18
Hide whitespace changes
Inline
Side-by-side
.gitignore
View file @
5f6aabab
...
...
@@ -34,6 +34,7 @@ tmp/
*.ufasl
*.vbin
*.~*~
*.sse2f
test/try-reloading-dependency.asd
test/fileMissing.lisp
test/hello-world-example
...
...
Makefile
View file @
5f6aabab
...
...
@@ -57,6 +57,9 @@ bump: bump-version
bump-version
:
build/asdf.lisp
./bin/asdf-builder bump-version
driver-files
:
@
echo
$(driver_lisp)
archive
:
build/asdf.lisp
#
${SBCL}
--userinit
/dev/null
--sysinit
/dev/null
--load
bin/make-helper.lisp
\
# --eval "
(
rewrite-license
)
" --eval "
(
quit
)
"
...
...
asdf-driver.asd
View file @
5f6aabab
...
...
@@ -14,7 +14,7 @@ that you can't portably construct a complete program without using them."
:defsystem-depends-on
(
#+
(
and
(
not
asdf2.27
)
(
or
clisp
xcl
))
:asdf
)
:around-compile
call-without-redefinition-warnings
:components
((
:
file
"heade
r"
)
((
:
static-file
"version.lisp-exp
r"
)
(
:file
"package"
)
(
:file
"compatibility"
:depends-on
(
"package"
))
(
:file
"utility"
:depends-on
(
"compatibility"
))
...
...
asdf.asd
View file @
5f6aabab
...
...
@@ -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.11
5
"
;; to be automatically updated by bin/bump-revision
:version
"2.26.11
6
"
;; 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
))))
...
...
@@ -37,6 +37,7 @@
:description
"All the components needed to build asdf.lisp"
:description
"Generate asdf.lisp based on this and monolithic-concatenate-source-op"
:defsystem-depends-on
(
:asdf
)
:version
(
:read-file-form
"version.lisp-expr"
)
:class
:bundle-system
:build-operation
monolithic-concatenate-source-op
:bundle-pathname
"build/asdf"
...
...
bin/asdf-builder
View file @
5f6aabab
...
...
@@ -12,7 +12,8 @@
(defun build-asdf ()
;; Make sure asdf.lisp is built.
(build-system :asdf/generate)
(load-system :asdf))
(load-system :asdf)
(values))
;;; ASDF directory
...
...
@@ -66,7 +67,8 @@
(defun run-program* (x)
(format t "~A~%" x)
(run-program/ x))
(run-program/ x)
(values))
(defun make-tarball-under-build (name base files)
(check-type name string)
...
...
@@ -106,7 +108,8 @@
/base/ /files/ /destination/))
(run-program* (format nil "tar zcfC ~S ~S ~S/"
/tarball/ /build-dir/ name))
(run-program* `("rm" "-rf" ,/destination/))))
(run-program* `("rm" "-rf" ,/destination/)))
(values))
(defun driver-files ()
(list* "asdf-driver.asd" "version.lisp-expr"
...
...
@@ -125,15 +128,32 @@
(build-asdf)
(make-tarball-under-build (asdf-system-name) *asdf-dir* (asdf-system-files)))
(defun asdf-git-name ()
(format nil "asdf-~A" *version*))
(defun make-git-tarball ()
(build-asdf)
(run-program* (format nil "cd ~S && tar zcf build/asdf-~A.tar.gz build/asdf.lisp $(git ls-files)"
/asdf-dir/ *version*)))
(run-program* (format nil "cd ~S && tar zcf build/~A.tar.gz build/asdf.lisp $(git ls-files)"
/asdf-dir/ (asdf-git-name)))
(values))
(defun make-tarballs ()
(make-driver-tarball)
(make-asdf-system-tarball)
(make-git-tarball))
(make-git-tarball)
(values))
(defun publish-tarballs ()
(let ((tarballs (mapcar 'tarname (list (driver-name) (asdf-system-name) (asdf-git-name)))))
(run-program* (format nil "cd ~S && rsync ~{~S ~}clnet:/project/asdf/public_html/archives/"
/build-dir/ tarballs)))
(format t "~&To download the tarballs, point your browser at:~%
http://common-lisp.net/project/asdf/archives/
~%")
(values))
(defun make-and-publish-tarballs ()
(make-tarballs)
(publish-tarballs))
(defparameter *versioned-files*
'(("version.lisp-expr" "\"" "\"")
...
...
bundle.lisp
View file @
5f6aabab
...
...
@@ -177,13 +177,13 @@
&allow-other-keys
)
(
operation-original-initargs
instance
)
(
setf
(
operation-original-initargs
instance
)
(
remove-keys
'
(
:lisp-files
:epilogue-code
:prologue-code
)
original-initargs
)
(
remove-
plist-
keys
'
(
:lisp-files
:epilogue-code
:prologue-code
)
original-initargs
)
(
monolithic-op-prologue-code
instance
)
prologue-code
(
monolithic-op-epilogue-code
instance
)
epilogue-code
)
#-
ecl
(
assert
(
null
(
or
lisp-files
epilogue-code
prologue-code
)))
#+
ecl
(
setf
(
bundle-op-lisp-files
instance
)
lisp-files
)))
(
setf
(
bundle-op-build-args
instance
)
(
remove-keys
'
(
:type
:monolithic
:name-suffix
)
(
remove-
plist-
keys
'
(
:type
:monolithic
:name-suffix
)
(
operation-original-initargs
instance
))))
(
defmethod
bundle-op-build-args
:around
((
o
lib-op
))
...
...
@@ -332,7 +332,7 @@
(
merge-pathnames
"./asdf-output/"
)))
(
operation
(
apply
#'
operate
operation-name
system
(
remove-keys
'
(
:monolithic
:type
:move-here
)
args
)))
(
remove-
plist-
keys
'
(
:monolithic
:type
:move-here
)
args
)))
(
system
(
find-system
system
))
(
files
(
and
system
(
output-files
operation
system
))))
(
if
(
or
move-here
(
and
(
null
move-here-p
)
...
...
configuration.lisp
View file @
5f6aabab
...
...
@@ -239,15 +239,16 @@ directive.")
(
when
directory
(
setf
ensure-directory
t
))
;; :directory backward compatibility, until 2014-01-16.
(
if
(
atom
x
)
(
resolve-absolute-location-component
x
:ensure-directory
ensure-directory
:wilden
wilden
)
(
loop
:with
path
=
(
resolve-absolute-location-component
(
car
x
)
:ensure-directory
(
and
(
or
ensure-directory
(
cdr
x
))
t
)
:wilden
(
and
wilden
(
null
(
cdr
x
))))
:for
(
component
.
morep
)
:on
(
cdr
x
)
(
loop
:with
(
first
.
rest
)
=
x
:with
path
=
(
resolve-absolute-location-component
first
:ensure-directory
(
and
(
or
ensure-directory
rest
)
t
)
:wilden
(
and
wilden
(
null
rest
)))
:for
(
element
.
morep
)
:on
rest
:for
dir
=
(
and
(
or
morep
ensure-directory
)
t
)
:for
wild
=
(
and
wilden
(
not
morep
))
:do
(
setf
path
(
merge-pathnames*
(
resolve-relative-location-component
compon
ent
:ensure-directory
dir
:wilden
wild
)
elem
ent
:ensure-directory
dir
:wilden
wild
)
path
))
:finally
(
return
path
))))
...
...
defsystem.lisp
View file @
5f6aabab
...
...
@@ -101,7 +101,7 @@
(
destructuring-bind
(
type
name
&rest
rest
&key
;; the following list of keywords is reproduced below in the
;; remove-keys form. important to keep them in sync
;; remove-
plist-
keys form. important to keep them in sync
components
pathname
perform
explain
output-files
operation-done-p
weakly-depends-on
depends-on
serial
do-first
if-component-dep-fails
(
version
nil
versionp
)
...
...
@@ -119,7 +119,7 @@
(
let*
((
args
`
(
:name
,
(
coerce-name
name
)
:pathname
,
pathname
,@
(
when
parent
`
(
:parent
,
parent
))
,@
(
remove-keys
,@
(
remove-
plist-
keys
'
(
:components
:pathname
:if-component-dep-fails
:version
:perform
:explain
:output-files
:operation-done-p
:weakly-depends-on
:depends-on
:serial
)
...
...
@@ -178,7 +178,7 @@
(
make-instance
'system
:name
name
:source-file
source-file
))))
(
system
(
reset-system
(
cdr
registered!
)
:name
name
:source-file
source-file
))
(
component-options
(
remove-key
:class
options
)))
(
component-options
(
remove-
plist-
key
:class
options
)))
(
apply
'load-systems
defsystem-depends-on
)
;; We change-class AFTER we loaded the defsystem-depends-on
;; since the class might be defined as part of those.
...
...
header.lisp
View file @
5f6aabab
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
;;; This is ASDF 2.26.11
5
: Another System Definition Facility.
;;; This is ASDF 2.26.11
6
: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
...
...
lisp-build.lisp
View file @
5f6aabab
...
...
@@ -275,7 +275,7 @@ If WARNINGS-FILE is defined, deferred warnings are saved to that file.
On ECL or MKCL, it creates both the linkable object and loadable fasl files.
On implementations that erroneously do not recognize standard keyword arguments,
it will filter them appropriately."
(
let*
((
keywords
(
remove-keys
(
let*
((
keywords
(
remove-
plist-
keys
`
(
:compile-check
:warnings-file
#+
gcl<2.7
,@'
(
:external-format
:print
:verbose
))
keys
))
(
output-file
(
apply
'compile-file-pathname*
input-file
:output-file
output-file
keywords
))
...
...
@@ -324,7 +324,7 @@ it will filter them appropriately."
(
defun*
compile-file-pathname*
(
input-file
&rest
keys
&key
output-file
&allow-other-keys
)
(
let*
((
keys
(
remove-keys
`
(
#+
(
and
allegro
(
not
(
version>=
8
2
)))
:external-format
(
remove-
plist-
keys
`
(
#+
(
and
allegro
(
not
(
version>=
8
2
)))
:external-format
,@
(
unless
output-file
'
(
:output-file
)))
keys
)))
(
if
(
absolute-pathname-p
output-file
)
;; what cfp should be doing, w/ mp* instead of mp
...
...
@@ -339,7 +339,7 @@ it will filter them appropriately."
(
etypecase
x
((
or
pathname
string
#-
(
or
gcl<2.7
clozure
allegro
)
stream
)
(
apply
'load
x
#-
gcl<2.7
keys
#+
gcl<2.7
(
remove-key
:external-format
keys
)))
#-
gcl<2.7
keys
#+
gcl<2.7
(
remove-
plist-
key
:external-format
keys
)))
#-
(
or
gcl<2.7
clozure
allegro
)
;; GCL 2.6 can't load from a string-input-stream
;; ClozureCL 1.6 can only load from file input stream
...
...
operate.lisp
View file @
5f6aabab
...
...
@@ -57,7 +57,8 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be:
(
let*
((
system
(
etypecase
system
(
system
system
)
((
or
string
symbol
)
(
find-system
system
))))
;; I'd like to remove-keys :force :force-not :verbose, but swank.asd relies on :force (!).
;; I'd like to remove-plist-keys :force :force-not :verbose,
;; but swank.asd relies on :force (!).
(
op
(
apply
'make-operation
operation-class
args
))
(
systems-being-operated
*systems-being-operated*
)
(
*systems-being-operated*
(
or
systems-being-operated
(
make-hash-table
:test
'equal
))))
...
...
pathname.lisp
View file @
5f6aabab
...
...
@@ -620,7 +620,7 @@ to throw an error if the pathname is absolute"
:directory
(
unless
file-only
(
cons
relative
path
))
:name
name
:type
type
:defaults
(
or
defaults
(
nil-pathname
)))
(
remove-keys
'
(
:type
:dot-dot
:defaults
)
keys
))))))
(
remove-
plist-
keys
'
(
:type
:dot-dot
:defaults
)
keys
))))))
(
defun*
unix-namestring
(
pathname
)
"Given a non-wild PATHNAME, return a Unix-style namestring for it.
...
...
@@ -769,11 +769,11 @@ then it is merged with the PATHNAME-DIRECTORY-PATHNAME of PATHNAME."
sofar
)))
(
loop
:with
directory
=
(
normalize-pathname-directory-component
(
pathname-directory
p
))
:for
component
:in
(
cdr
directory
)
:for
dir
:in
(
cdr
directory
)
:for
rest
:on
(
cdr
directory
)
:for
more
=
(
probe-file*
(
merge-pathnames*
(
make-pathname*
:directory
`
(
:relative
,
component
))
(
make-pathname*
:directory
`
(
:relative
,
dir
))
sofar
))
:do
(
if
more
(
setf
sofar
more
)
...
...
plan.lisp
View file @
5f6aabab
...
...
@@ -321,7 +321,7 @@ processed in order by OPERATE."))
(
defmethod
traverse
((
o
operation
)
(
c
component
)
&rest
keys
&key
plan-class
&allow-other-keys
)
(
let
((
plan
(
apply
'make-instance
(
or
plan-class
*default-plan-class*
)
:system
(
component-system
c
)
(
remove-key
:plan-class
keys
))))
:system
(
component-system
c
)
(
remove-
plist-
key
:plan-class
keys
))))
(
traverse-action
plan
o
c
t
)
(
plan-actions
plan
)))
...
...
stream.lisp
View file @
5f6aabab
...
...
@@ -245,7 +245,7 @@ and read its contents as per SLURP-STREAM-FORMS with given COUNT.
BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
(
apply
'call-with-input-file
file
#'
(
lambda
(
input
)
(
slurp-stream-forms
input
:count
count
))
(
remove-key
:count
keys
)))
(
remove-
plist-
key
:count
keys
)))
(
defun*
read-file-form
(
file
&rest
keys
&key
(
path
0
)
&allow-other-keys
)
"Open input FILE with option KEYS (except path),
...
...
@@ -253,14 +253,14 @@ and read its contents as per SLURP-STREAM-FORM with given PATH.
BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
(
apply
'call-with-input-file
file
#'
(
lambda
(
input
)
(
slurp-stream-form
input
:path
path
))
(
remove-key
:path
keys
)))
(
remove-
plist-
key
:path
keys
)))
(
defun*
safe-read-file-form
(
pathname
&rest
keys
&key
(
package
:cl
)
&allow-other-keys
)
"Reads the specified form from the top of a file using a safe standardized syntax.
Extracts the form using READ-FILE-FORM,
within an WITH-SAFE-IO-SYNTAX using the specified PACKAGE."
(
with-safe-io-syntax
(
:package
package
)
(
apply
'read-file-form
pathname
(
remove-key
:package
keys
))))
(
apply
'read-file-form
pathname
(
remove-
plist-
key
:package
keys
))))
(
defun*
eval-input
(
input
)
"Portably read and evaluate forms from INPUT, return the last values."
...
...
test/test-program.script
View file @
5f6aabab
...
...
@@ -10,6 +10,7 @@
(assert (absolute-pathname-p exe))
(unless (and #-(or clisp clozure cmu ecl lispworks sbcl) nil
#+cmu nil ;; uncomment if you have 32-bit gcc support - or can autodetect
#+clisp (version-satisfies
(first (split-string (lisp-implementation-version) :separator " "))
"2.48"))
...
...
upgrade.lisp
View file @
5f6aabab
...
...
@@ -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.11
5
"
)
(
asdf-version
"2.26.11
6
"
)
(
existing-asdf
(
find-class
(
find-symbol*
:component
:asdf
nil
)
nil
))
(
existing-version
*asdf-version*
)
(
already-there
(
equal
asdf-version
existing-version
)))
...
...
utility.lisp
View file @
5f6aabab
...
...
@@ -10,7 +10,7 @@
#:asdf-debug
#:load-asdf-debug-utility
#:*asdf-debug-utility*
#:undefine-function
#:undefine-functions
#:defun*
#:defgeneric*
;; (un)defining functions
#:if-let
;; basic flow control
#:while-collecting
#:appendf
#:length=n-p
#:remove-keys
#:remove-key
;; lists and plists
#:while-collecting
#:appendf
#:length=n-p
#:remove-
plist-
keys
#:remove-
plist-
key
;; lists and plists
#:emptyp
;; sequences
#:first-char
#:last-char
#:split-string
;; strings
#:string-prefix-p
#:string-enclosed-p
#:string-suffix-p
...
...
@@ -132,13 +132,13 @@ Returns two values: \(A B C\) and \(1 2 3\)."
((
not
(
consp
l
))
(
return
nil
)))))
;;; remove a key from a plist, i.e. for keyword argument cleanup
(
defun*
remove-key
(
key
plist
)
(
defun*
remove-
plist-
key
(
key
plist
)
"Remove a single key from a plist"
(
loop
:for
(
k
v
)
:on
plist
:by
#'
cddr
:unless
(
eq
k
key
)
:append
(
list
k
v
)))
(
defun*
remove-keys
(
keys
plist
)
(
defun*
remove-
plist-
keys
(
keys
plist
)
"Remove a list of keys from a plist"
(
loop
:for
(
k
v
)
:on
plist
:by
#'
cddr
:unless
(
member
k
keys
)
...
...
version.lisp-expr
View file @
5f6aabab
"2.26.11
5
"
"2.26.11
6
"
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