Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
A
asdf
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
18
Issues
18
List
Boards
Labels
Service Desk
Milestones
Merge Requests
11
Merge Requests
11
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
asdf
asdf
Commits
ab797258
Commit
ab797258
authored
Jan 28, 2013
by
Francois-Rene Rideau
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
2.26.162: improve the upgrade cleanup mechanism
Make it run even if ASDF wasn't upgraded via upgrade-asdf.
parent
64b4399e
Changes
13
Hide whitespace changes
Inline
Side-by-side
Showing
13 changed files
with
113 additions
and
128 deletions
+113
-128
asdf.asd
asdf.asd
+1
-1
backward-internals.lisp
backward-internals.lisp
+1
-1
component.lisp
component.lisp
+2
-2
configuration.lisp
configuration.lisp
+9
-1
find-system.lisp
find-system.lisp
+6
-4
footer.lisp
footer.lisp
+3
-9
header.lisp
header.lisp
+1
-1
operate.lisp
operate.lisp
+0
-9
operation.lisp
operation.lisp
+1
-1
output-translations.lisp
output-translations.lisp
+1
-1
upgrade.lisp
upgrade.lisp
+85
-95
utility.lisp
utility.lisp
+2
-2
version.lisp-expr
version.lisp-expr
+1
-1
No files found.
asdf.asd
View file @
ab797258
...
...
@@ -62,7 +62,7 @@
:licence
"MIT"
:description
"Another System Definition Facility"
:long-description
"ASDF builds Common Lisp software organized into defined systems."
:version
"2.26.16
1
"
;; to be automatically updated by make bump-version
:version
"2.26.16
2
"
;; 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.
...
...
backward-internals.lisp
View file @
ab797258
...
...
@@ -69,7 +69,7 @@
:when
(
eq
feature?
'feature
)
:do
(
setf
(
component-if-feature
c
)
feature
)))))
(
when-upgrad
e
(
:when
(
fboundp
'make-sub-operation
))
(
when-upgrad
ing
(
:when
(
fboundp
'make-sub-operation
))
(
defun*
make-sub-operation
(
c
o
dep-c
dep-o
)
(
declare
(
ignore
c
o
dep-c
dep-o
))
(
asdf-upgrade-error
)))
...
...
component.lisp
View file @
ab797258
...
...
@@ -57,7 +57,7 @@ another pathname in a degenerate way."))
;;; TODO: find users, have them stop using that.
(
defgeneric*
(
source-file-type
)
(
component
system
))
(
when-upgrad
e
(
:when
(
find-class
'component
nil
))
(
when-upgrad
ing
(
:when
(
find-class
'component
nil
))
(
defmethod
reinitialize-instance
:after
((
c
component
)
&rest
initargs
&key
)
(
declare
(
ignorable
c
initargs
))
(
values
)))
...
...
@@ -168,7 +168,7 @@ another pathname in a degenerate way."))
(
setf
(
gethash
name
hash
)
c
))
hash
))))
(
when-upgrad
e
(
:when
(
find-class
'module
nil
))
(
when-upgrad
ing
(
:when
(
find-class
'module
nil
))
(
defmethod
reinitialize-instance
:after
((
m
module
)
&rest
initargs
&key
)
(
declare
(
ignorable
m
initargs
))
(
values
))
(
defmethod
update-instance-for-redefined-class
:after
...
...
configuration.lisp
View file @
ab797258
...
...
@@ -15,7 +15,7 @@
#:report-invalid-form
#:invalid-configuration
#:*ignored-configuration-form*
#:*clear-configuration-hook*
#:clear-configuration
#:register-clear-configuration-hook
#:resolve-location
#:location-designator-p
#:location-function-p
#:*here-directory*
#:resolve-relative-location
#:resolve-absolute-location
))
#:resolve-relative-location
#:resolve-absolute-location
#:upgrade-configuration
))
(
in-package
:asdf/configuration
)
(
define-condition
invalid-configuration
()
...
...
@@ -286,3 +286,11 @@ directive.")
(
call-functions
*clear-configuration-hook*
))
(
register-image-dump-hook
'clear-configuration
)
;; If a previous version of ASDF failed to read some configuration, try again.
(
defun*
upgrade-configuration
()
(
when
*ignored-configuration-form*
(
clear-configuration
)
(
setf
*ignored-configuration-form*
nil
)))
find-system.lisp
View file @
ab797258
...
...
@@ -56,16 +56,18 @@
(
error
'formatted-system-definition-error
:format-control
format
:format-arguments
arguments
))
(
defun*
make-defined-systems-table
()
(
make-hash-table
:test
'equal
))
(
defvar
*defined-systems*
(
make-defined-systems-table
)
(
defvar
*defined-systems*
(
make-hash-table
:test
'equal
)
"This is a hash table whose keys are strings, being the
names of the systems, and whose values are pairs, the first
element of which is a universal-time indicating when the
system definition was last updated, and the second element
of which is a system object."
)
(
defun*
clear-defined-systems
()
(
setf
*defined-systems*
(
make-hash-table
:test
'equal
)))
(
register-hook-function
'*post-upgrade-cleanup-hook*
'clear-defined-systems
nil
)
(
defun*
coerce-name
(
name
)
(
typecase
name
(
component
(
component-name
name
))
...
...
footer.lisp
View file @
ab797258
...
...
@@ -40,15 +40,6 @@
(
values-list
l
))))))
;;;; Cleanups after hot-upgrade.
;; Things to do in case we're upgrading from a previous version of ASDF.
;; See https://bugs.launchpad.net/asdf/+bug/485687
;;
;; If a previous version of ASDF failed to read some configuration, try again.
(
when
*ignored-configuration-form*
(
clear-configuration
)
(
setf
*ignored-configuration-form*
nil
))
;;;; Done!
#+
allegro
...
...
@@ -60,6 +51,9 @@
(
provide
:asdf
)
;;;; Cleanups after hot-upgrade.
(
cleanup-upgraded-asdf
)
(
when
*load-verbose*
(
asdf-message
";; ASDF, version ~a~%"
(
asdf-version
)))
...
...
header.lisp
View file @
ab797258
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.26.16
1
: Another System Definition Facility.
;;; This is ASDF 2.26.16
2
: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
...
...
operate.lisp
View file @
ab797258
...
...
@@ -157,14 +157,6 @@ for how to load or compile stuff")
;;;; Some upgrade magic
(
defun*
reset-asdf-systems
()
(
let
((
asdf
(
find-system
:asdf
)))
(
setf
(
component-version
asdf
)
(
asdf-version
))
;; Invalidate all systems but ASDF itself.
(
setf
*defined-systems*
(
make-defined-systems-table
))
(
register-system
asdf
)
(
load-system
asdf
)))
;; re-load ourselves the right way
(
defun*
restart-upgraded-asdf
()
;; If we're in the middle of something, restart it.
(
when
*systems-being-defined*
...
...
@@ -172,5 +164,4 @@ for how to load or compile stuff")
(
clrhash
*systems-being-defined*
)
(
dolist
(
s
l
)
(
find-system
s
nil
)))))
(
pushnew
'reset-asdf-systems
*post-upgrade-cleanup-hook*
)
(
pushnew
'restart-upgraded-asdf
*post-upgrade-restart-hook*
)
operation.lisp
View file @
ab797258
...
...
@@ -15,7 +15,7 @@
;;; Operation Classes
(
when-upgrad
e
(
:when
(
find-class
'operation
nil
))
(
when-upgrad
ing
(
:when
(
find-class
'operation
nil
))
(
defmethod
shared-initialize
:after
((
o
operation
)
slot-names
&rest
initargs
&key
)
(
declare
(
ignorable
o
slot-names
initargs
))
(
values
)))
...
...
output-translations.lisp
View file @
ab797258
...
...
@@ -22,7 +22,7 @@
))
(
in-package
:asdf/output-translations
)
(
when-upgrad
e
()
(
undefine-function
'
(
setf
output-translations
)))
(
when-upgrad
ing
()
(
undefine-function
'
(
setf
output-translations
)))
(
define-condition
invalid-output-translation
(
invalid-configuration
warning
)
((
format
:initform
(
compatfmt
"~@<Invalid asdf output-translation ~S~@[ in ~S~]~@{ ~@?~}~@:>"
))))
...
...
upgrade.lisp
View file @
ab797258
...
...
@@ -4,13 +4,12 @@
(
asdf/package:define-package
:asdf/upgrade
(
:recycle
:asdf/upgrade
:asdf
)
(
:use
:asdf/common-lisp
:asdf/
package
:asdf/utility
)
(
:use
:asdf/common-lisp
:asdf/
driver
)
(
:export
#:upgrade-asdf
#:asdf-upgrade-error
#:when-upgrade
#:*asdf-upgrade-already-attempted*
#:*post-upgrade-cleanup-hook*
#:*post-upgrade-restart-hook*
#:cleanup-upgraded-asdf
#:asdf-version
#:*upgraded-p*
#:*asdf-version*
#:asdf-version
#:*previous-asdf-versions*
#:*asdf-version*
#:asdf-message
#:*asdf-verbose*
#:*verbose-out*
#:upgrading-p
#:when-upgrading
#:upgrade-asdf
#:asdf-upgrade-error
#:*post-upgrade-cleanup-hook*
#:*post-upgrade-restart-hook*
#:cleanup-upgraded-asdf
;; There will be no symbol left behind!
#:intern*
)
(
:import-from
:asdf/package
#:intern*
#:find-symbol*
))
...
...
@@ -19,30 +18,57 @@
;;; Special magic to detect if this is an upgrade
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
(
defun
asdf-version
()
"Exported interface to the version of ASDF currently installed. A string.
You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSION) \"3.4.5.67\")."
(
when
(
find-package
:asdf
)
(
or
(
symbol-value
(
find-symbol
(
string
:*asdf-version*
)
:asdf
))
(
let
((
ver
(
symbol-value
(
find-symbol
(
string
:*asdf-revision*
)
:asdf
))))
(
etypecase
ver
(
string
ver
)
(
cons
(
format
nil
"~{~D~^.~}"
ver
))
(
null
"1.0"
))))))
(
defvar
*asdf-version*
nil
)
(
defvar
*
upgraded-p
*
nil
)
(
defvar
*
previous-asdf-versions
*
nil
)
(
defvar
*asdf-verbose*
nil
)
; was t from 2.000 to 2.014.12.
(
defvar
*verbose-out*
nil
)
(
defun*
asdf-message
(
format-string
&rest
format-args
)
(
apply
'format
*verbose-out*
format-string
format-args
)))
(
apply
'format
*verbose-out*
format-string
format-args
))
(
defvar
*post-upgrade-cleanup-hook*
())
(
defvar
*post-upgrade-restart-hook*
())
(
defun*
upgrading-p
()
(
and
*previous-asdf-versions*
(
not
(
equal
*asdf-version*
(
first
*previous-asdf-versions*
)))))
(
defmacro
when-upgrading
((
&key
(
upgrading-p
'
(
upgrading-p
))
when
)
&body
body
)
`
(
eval-when
(
:compile-toplevel
:load-toplevel
:execute
)
(
when
(
and
,
upgrading-p
,@
(
when
when
`
(
,
when
)))
(
handler-bind
((
style-warning
#'
muffle-warning
))
(
eval
'
(
progn
,@
body
)))))))
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
(
let*
(
;; For bug reporting sanity, please always bump this version when you modify this file.
;; Please also modify asdf.asd to reflect this change. make bump-version
;; Please also modify asdf.asd to reflect this change. make bump-version
v=3.4.5.67.8
;; can help you do these changes in synch (look at the source for documentation).
;; Relying on its automation, the version is now redundantly present on top of this file.
;; "2.345" would be an official release
;; "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.161"
)
(
existing-asdf
(
find-class
(
find-symbol*
:component
:asdf
nil
)
nil
))
(
existing-version
*asdf-version*
)
(
already-there
(
equal
asdf-version
existing-version
))
(
redefined-functions
;; gf signature and/or semantics changed incompatibly. Oops.
'
(
#:component-relative-pathname
#:component-parent-pathname
;; component
#:source-file-type
#:find-system
#:system-source-file
#:system-relative-pathname
;; system
;; "3.4" would be the general branch for major version 3, minor version 4.
;; "3.4.5" would be an official release in the 3.4 branch.
;; "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.26.162"
)
(
existing-version
(
asdf-version
)))
(
when
(
and
existing-version
(
not
(
equal
asdf-version
existing-version
)))
(
push
existing-version
*previous-asdf-versions*
)
(
when
*asdf-verbose*
(
format
*trace-output*
(
compatfmt
"~&~@<; ~@;Upgrading ASDF ~@[from version ~A ~]to version ~A~@:>~%"
)
existing-version
asdf-version
)))
(
setf
*asdf-version*
asdf-version
)))
(
when-upgrading
()
(
let
((
redefined-functions
;; gf signature and/or semantics changed incompatibly. Oops.
'
(
#:component-relative-pathname
#:component-parent-pathname
;; component
#:source-file-type
#:find-system
#:system-source-file
#:system-relative-pathname
;; system
#:find-component
;; find-component
#:explain
#:perform
#:perform-with-restarts
#:input-files
#:output-files
;; action
#:component-depends-on
#:component-self-dependencies
#:operation-done-p
...
...
@@ -51,7 +77,7 @@
#:apply-output-translations
;; output-translations
#:process-output-translations-directive
#:inherit-source-registry
#:process-source-registry
;; source-registry
#:process-source-registry-directive
#:process-source-registry-directive
#:trivial-system-p
;; bundle
;; NB: it's too late to do anything about asdf-driver functions!
))
...
...
@@ -61,93 +87,57 @@
#:resolve-relative-location-component
#:resolve-absolute-location-component
#:output-files-for-system-and-operation
)))
; obsolete ASDF-BINARY-LOCATION function
(
declare
(
ignorable
redefined-functions
uninterned-symbols
))
(
setf
*asdf-version*
asdf-version
)
(
when
(
and
existing-asdf
(
not
already-there
))
(
push
existing-version
*upgraded-p*
)
(
when
*asdf-verbose*
(
format
*trace-output*
(
compatfmt
"~&~@<; ~@;Upgrading ASDF ~@[from version ~A ~]to version ~A~@:>~%"
)
existing-version
asdf-version
))
(
loop
:for
name
:in
(
append
#-
(
or
clisp
ecl
)
redefined-functions
)
:for
sym
=
(
find-symbol*
name
:asdf
nil
)
:do
(
when
sym
;;(format t "Undefining ~S~%" sym);XXX
(
fmakunbound
sym
)))
(
loop
:with
asdf
=
(
find-package
:asdf
)
:for
name
:in
(
append
#+
(
or
clisp
ecl
)
redefined-functions
uninterned-symbols
)
;XXX
:for
sym
=
(
find-symbol*
name
:asdf
nil
)
:for
base-pkg
=
(
and
sym
(
symbol-package
sym
))
:do
(
when
sym
;;(format t "frobbing symbol ~S~%" sym);XXX
(
cond
((
or
(
eq
base-pkg
asdf
)
(
not
base-pkg
))
(
unintern*
sym
asdf
)
(
intern*
sym
asdf
))
(
t
(
unintern*
sym
base-pkg
)
(
let
((
new
(
intern*
sym
base-pkg
)))
(
shadowing-import
new
asdf
))))))
;; Note that this massive package destruction makes it impossible
;; to use asdf/driver on top of an old ASDF on these implementations
#+
(
or
xcl
)
(
let
((
p
(
find-package
:asdf
)))
(
when
p
(
do-symbols
(
s
p
)
(
when
(
home-package-p
s
p
)
(
nuke-symbol
s
)))
(
rename-package-away
p
:prefix
(
format
nil
"~A-~A"
:asdf
(
or
existing-version
:1.x
))
:index
0
:separator
"-"
))))))
(
loop
:for
name
:in
(
append
#-
(
or
clisp
ecl
)
redefined-functions
)
:for
sym
=
(
find-symbol*
name
:asdf
nil
)
:do
(
when
sym
(
fmakunbound
sym
)))
(
loop
:with
asdf
=
(
find-package
:asdf
)
:for
name
:in
(
append
#+
(
or
clisp
ecl
)
redefined-functions
uninterned-symbols
)
;XXX
:for
sym
=
(
find-symbol*
name
:asdf
nil
)
:for
base-pkg
=
(
and
sym
(
symbol-package
sym
))
:do
(
when
sym
(
cond
((
or
(
eq
base-pkg
asdf
)
(
not
base-pkg
))
(
unintern*
sym
asdf
)
(
intern*
sym
asdf
))
(
t
(
unintern*
sym
base-pkg
)
(
let
((
new
(
intern*
sym
base-pkg
)))
(
shadowing-import
new
asdf
))))))))
;;;
Upgrade interface
;;;
Self-upgrade functions
(
defun*
asdf-upgrade-error
()
;; Important notice for whom it concerns. The crux of the matter is that
;; TRAVERSE can be completely refactored, and so after the find-system returns, it's too late.
(
error
"When a system transitively depends on ASDF, it must :defsystem-depends-on (:asdf)~%~
Otherwise, when you upgrade ASDF, you must do it before you operate on any system.~%"
))
(
defmacro
when-upgrade
((
&key
(
upgraded-p
'*upgraded-p*
)
when
)
&body
body
)
`
(
eval-when
(
:compile-toplevel
:load-toplevel
:execute
)
(
when
(
and
,
upgraded-p
,@
(
when
when
`
(
,
when
)))
(
handler-bind
((
style-warning
#'
muffle-warning
))
(
eval
'
(
progn
,@
body
))))))
(
defun*
asdf-version
()
"Exported interface to the version of ASDF currently installed. A string.
You can compare this string with e.g.:
(ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSION) \"2.345.67\")."
*asdf-version*
)
Otherwise, when you upgrade from ASDF 2, you must do it before you operate on any system.~%"
))
;;; Self-upgrade functions
(
defvar
*post-upgrade-cleanup-hook*
())
(
defvar
*post-upgrade-restart-hook*
())
(
defun*
cleanup-upgraded-asdf
(
old-version
)
(
defun*
cleanup-upgraded-asdf
(
&optional
(
old-version
(
first
*previous-asdf-versions*
)))
(
let
((
new-version
(
asdf-version
)))
(
unless
(
equal
old-version
new-version
)
(
cond
((
version-compatible-p
new-version
old-version
)
(
asdf-message
(
compatfmt
"~&~@<; ~@;Upgraded ASDF from version ~A to version ~A~@:>~%"
)
old-version
new-version
))
((
version-compatible-p
old-version
new-version
)
(
warn
(
compatfmt
"~&~@<; ~@;Downgraded ASDF from version ~A to version ~A~@:>~%"
)
old-version
new-version
))
(
t
(
asdf-message
(
compatfmt
"~&~@<; ~@;Changed ASDF from version ~A to incompatible version ~A~@:>~%"
)
old-version
new-version
)))
(
dolist
(
h
(
reverse
*post-upgrade-cleanup-hook*
))
(
funcall
(
ensure-function
h
)))
(
dolist
(
h
*post-upgrade-restart-hook*
)
(
funcall
(
ensure-function
h
)))
t
)))
(
push
new-version
*previous-asdf-versions*
)
(
when
old-version
(
cond
((
version-compatible-p
new-version
old-version
)
(
asdf-message
(
compatfmt
"~&~@<; ~@;Upgraded ASDF from version ~A to version ~A~@:>~%"
)
old-version
new-version
))
((
version-compatible-p
old-version
new-version
)
(
warn
(
compatfmt
"~&~@<; ~@;Downgraded ASDF from version ~A to version ~A~@:>~%"
)
old-version
new-version
))
(
t
(
asdf-message
(
compatfmt
"~&~@<; ~@;Changed ASDF from version ~A to incompatible version ~A~@:>~%"
)
old-version
new-version
)))
(
call-functions
(
reverse
*post-upgrade-cleanup-hook*
))
t
))))
(
defun*
upgrade-asdf
()
"Try to upgrade of ASDF. If a different version was used, return T.
We need do that before we operate on anything that may possibly depend on ASDF."
(
let
((
version
(
asdf-version
))
(
*load-print*
nil
)
(
let
((
*load-print*
nil
)
(
*compile-print*
nil
))
(
handler-bind
(((
or
style-warning
warning
)
#'
muffle-warning
))
(
symbol-call
:asdf
:load-system
:asdf
:verbose
nil
))
(
cleanup-upgraded-asdf
version
)))
(
symbol-call
:asdf
:load-system
:asdf
:verbose
nil
))))
(
register-hook-function
'*post-upgrade-cleanup-hook*
'upgrade-configuration
)
utility.lisp
View file @
ab797258
...
...
@@ -308,7 +308,7 @@ instead of a list."
(
defun*
call-functions
(
function-specs
)
(
map
()
'call-function
function-specs
))
(
defun*
register-hook-function
(
variable
hook
&optional
(
call-now-p
t
)
)
(
defun*
register-hook-function
(
variable
hook
&optional
call-now-p
)
(
pushnew
hook
(
symbol-value
variable
))
(
when
call-now-p
(
call-function
hook
)))
...
...
@@ -372,8 +372,8 @@ with later being determined by a lexicographical comparison of minor numbers."
#+
allegro
'excl::format-control
#+
clisp
'system::$format-control
#+
clozure
'ccl::format-control
#+
ecl
'si::format-control
#+
(
or
cmu
scl
)
'conditions::format-control
#+
ecl
'si::format-control
#+
(
or
gcl
lispworks
)
'conditions::format-string
#+
sbcl
'sb-kernel:format-control
#-
(
or
abcl
allegro
clisp
clozure
cmu
ecl
gcl
lispworks
sbcl
scl
)
nil
...
...
version.lisp-expr
View file @
ab797258
"2.26.16
1
"
"2.26.16
2
"
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