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
15
Issues
15
List
Boards
Labels
Service Desk
Milestones
Merge Requests
9
Merge Requests
9
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 @@
...
@@ -62,7 +62,7 @@
:licence
"MIT"
:licence
"MIT"
:description
"Another System Definition Facility"
:description
"Another System Definition Facility"
:long-description
"ASDF builds Common Lisp software organized into defined systems."
: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
()
:depends-on
()
#+
asdf3
:encoding
#+
asdf3
:utf-8
#+
asdf3
:encoding
#+
asdf3
:utf-8
;; For most purposes, asdf itself specially counts as a builtin system.
;; For most purposes, asdf itself specially counts as a builtin system.
...
...
backward-internals.lisp
View file @
ab797258
...
@@ -69,7 +69,7 @@
...
@@ -69,7 +69,7 @@
:when
(
eq
feature?
'feature
)
:do
:when
(
eq
feature?
'feature
)
:do
(
setf
(
component-if-feature
c
)
feature
)))))
(
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
)
(
defun*
make-sub-operation
(
c
o
dep-c
dep-o
)
(
declare
(
ignore
c
o
dep-c
dep-o
))
(
asdf-upgrade-error
)))
(
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."))
...
@@ -57,7 +57,7 @@ another pathname in a degenerate way."))
;;; TODO: find users, have them stop using that.
;;; TODO: find users, have them stop using that.
(
defgeneric*
(
source-file-type
)
(
component
system
))
(
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
)
(
defmethod
reinitialize-instance
:after
((
c
component
)
&rest
initargs
&key
)
(
declare
(
ignorable
c
initargs
))
(
values
)))
(
declare
(
ignorable
c
initargs
))
(
values
)))
...
@@ -168,7 +168,7 @@ another pathname in a degenerate way."))
...
@@ -168,7 +168,7 @@ another pathname in a degenerate way."))
(
setf
(
gethash
name
hash
)
c
))
(
setf
(
gethash
name
hash
)
c
))
hash
))))
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
)
(
defmethod
reinitialize-instance
:after
((
m
module
)
&rest
initargs
&key
)
(
declare
(
ignorable
m
initargs
))
(
values
))
(
declare
(
ignorable
m
initargs
))
(
values
))
(
defmethod
update-instance-for-redefined-class
:after
(
defmethod
update-instance-for-redefined-class
:after
...
...
configuration.lisp
View file @
ab797258
...
@@ -15,7 +15,7 @@
...
@@ -15,7 +15,7 @@
#:report-invalid-form
#:invalid-configuration
#:*ignored-configuration-form*
#:report-invalid-form
#:invalid-configuration
#:*ignored-configuration-form*
#:*clear-configuration-hook*
#:clear-configuration
#:register-clear-configuration-hook
#:*clear-configuration-hook*
#:clear-configuration
#:register-clear-configuration-hook
#:resolve-location
#:location-designator-p
#:location-function-p
#:*here-directory*
#: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
)
(
in-package
:asdf/configuration
)
(
define-condition
invalid-configuration
()
(
define-condition
invalid-configuration
()
...
@@ -286,3 +286,11 @@ directive.")
...
@@ -286,3 +286,11 @@ directive.")
(
call-functions
*clear-configuration-hook*
))
(
call-functions
*clear-configuration-hook*
))
(
register-image-dump-hook
'clear-configuration
)
(
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 @@
...
@@ -56,16 +56,18 @@
(
error
'formatted-system-definition-error
:format-control
(
error
'formatted-system-definition-error
:format-control
format
:format-arguments
arguments
))
format
:format-arguments
arguments
))
(
defun*
make-defined-systems-table
()
(
defvar
*defined-systems*
(
make-hash-table
:test
'equal
)
(
make-hash-table
:test
'equal
))
(
defvar
*defined-systems*
(
make-defined-systems-table
)
"This is a hash table whose keys are strings, being the
"This is a hash table whose keys are strings, being the
names of the systems, and whose values are pairs, the first
names of the systems, and whose values are pairs, the first
element of which is a universal-time indicating when the
element of which is a universal-time indicating when the
system definition was last updated, and the second element
system definition was last updated, and the second element
of which is a system object."
)
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
)
(
defun*
coerce-name
(
name
)
(
typecase
name
(
typecase
name
(
component
(
component-name
name
))
(
component
(
component-name
name
))
...
...
footer.lisp
View file @
ab797258
...
@@ -40,15 +40,6 @@
...
@@ -40,15 +40,6 @@
(
values-list
l
))))))
(
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!
;;;; Done!
#+
allegro
#+
allegro
...
@@ -60,6 +51,9 @@
...
@@ -60,6 +51,9 @@
(
provide
:asdf
)
(
provide
:asdf
)
;;;; Cleanups after hot-upgrade.
(
cleanup-upgraded-asdf
)
(
when
*load-verbose*
(
when
*load-verbose*
(
asdf-message
";; ASDF, version ~a~%"
(
asdf-version
)))
(
asdf-message
";; ASDF, version ~a~%"
(
asdf-version
)))
...
...
header.lisp
View file @
ab797258
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; -*- 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:
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
;;; please mail to <asdf-devel@common-lisp.net>.
...
...
operate.lisp
View file @
ab797258
...
@@ -157,14 +157,6 @@ for how to load or compile stuff")
...
@@ -157,14 +157,6 @@ for how to load or compile stuff")
;;;; Some upgrade magic
;;;; 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
()
(
defun*
restart-upgraded-asdf
()
;; If we're in the middle of something, restart it.
;; If we're in the middle of something, restart it.
(
when
*systems-being-defined*
(
when
*systems-being-defined*
...
@@ -172,5 +164,4 @@ for how to load or compile stuff")
...
@@ -172,5 +164,4 @@ for how to load or compile stuff")
(
clrhash
*systems-being-defined*
)
(
clrhash
*systems-being-defined*
)
(
dolist
(
s
l
)
(
find-system
s
nil
)))))
(
dolist
(
s
l
)
(
find-system
s
nil
)))))
(
pushnew
'reset-asdf-systems
*post-upgrade-cleanup-hook*
)
(
pushnew
'restart-upgraded-asdf
*post-upgrade-restart-hook*
)
(
pushnew
'restart-upgraded-asdf
*post-upgrade-restart-hook*
)
operation.lisp
View file @
ab797258
...
@@ -15,7 +15,7 @@
...
@@ -15,7 +15,7 @@
;;; Operation Classes
;;; 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
)
(
defmethod
shared-initialize
:after
((
o
operation
)
slot-names
&rest
initargs
&key
)
(
declare
(
ignorable
o
slot-names
initargs
))
(
values
)))
(
declare
(
ignorable
o
slot-names
initargs
))
(
values
)))
...
...
output-translations.lisp
View file @
ab797258
...
@@ -22,7 +22,7 @@
...
@@ -22,7 +22,7 @@
))
))
(
in-package
:asdf/output-translations
)
(
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
)
(
define-condition
invalid-output-translation
(
invalid-configuration
warning
)
((
format
:initform
(
compatfmt
"~@<Invalid asdf output-translation ~S~@[ in ~S~]~@{ ~@?~}~@:>"
))))
((
format
:initform
(
compatfmt
"~@<Invalid asdf output-translation ~S~@[ in ~S~]~@{ ~@?~}~@:>"
))))
...
...
upgrade.lisp
View file @
ab797258
...
@@ -4,13 +4,12 @@
...
@@ -4,13 +4,12 @@
(
asdf/package:define-package
:asdf/upgrade
(
asdf/package:define-package
:asdf/upgrade
(
:recycle
:asdf/upgrade
:asdf
)
(
:recycle
:asdf/upgrade
:asdf
)
(
:use
:asdf/common-lisp
:asdf/
package
:asdf/utility
)
(
:use
:asdf/common-lisp
:asdf/
driver
)
(
:export
(
:export
#:upgrade-asdf
#:asdf-upgrade-error
#:when-upgrade
#:asdf-version
#:*previous-asdf-versions*
#:*asdf-version*
#:*asdf-upgrade-already-attempted*
#:*post-upgrade-cleanup-hook*
#:*post-upgrade-restart-hook*
#:cleanup-upgraded-asdf
#:asdf-version
#:*upgraded-p*
#:*asdf-version*
#:asdf-message
#:*asdf-verbose*
#:*verbose-out*
#: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!
;; There will be no symbol left behind!
#:intern*
)
#:intern*
)
(
:import-from
:asdf/package
#:intern*
#:find-symbol*
))
(
:import-from
:asdf/package
#:intern*
#:find-symbol*
))
...
@@ -19,30 +18,57 @@
...
@@ -19,30 +18,57 @@
;;; Special magic to detect if this is an upgrade
;;; Special magic to detect if this is an upgrade
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
(
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
*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
*asdf-verbose*
nil
)
; was t from 2.000 to 2.014.12.
(
defvar
*verbose-out*
nil
)
(
defvar
*verbose-out*
nil
)
(
defun*
asdf-message
(
format-string
&rest
format-args
)
(
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
)
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
(
let*
(
;; For bug reporting sanity, please always bump this version when you modify this file.
(
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).
;; 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.
;; Relying on its automation, the version is now redundantly present on top of this file.
;; "2.345" would be an official release
;; "3.4" would be the general branch for major version 3, minor version 4.
;; "2.345.6" would be a development version in the official upstream
;; "3.4.5" would be an official release in the 3.4 branch.
;; "2.345.0.7" would be your seventh local modification of official release 2.345
;; "3.4.5.67" would be a development version in the official upstream of 3.4.5.
;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
(
asdf-version
"2.26.161"
)
;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
(
existing-asdf
(
find-class
(
find-symbol*
:component
:asdf
nil
)
nil
))
(
asdf-version
"2.26.162"
)
(
existing-version
*asdf-version*
)
(
existing-version
(
asdf-version
)))
(
already-there
(
equal
asdf-version
existing-version
))
(
when
(
and
existing-version
(
not
(
equal
asdf-version
existing-version
)))
(
redefined-functions
;; gf signature and/or semantics changed incompatibly. Oops.
(
push
existing-version
*previous-asdf-versions*
)
'
(
#:component-relative-pathname
#:component-parent-pathname
;; component
(
when
*asdf-verbose*
#:source-file-type
(
format
*trace-output*
#:find-system
#:system-source-file
#:system-relative-pathname
;; system
(
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
#:find-component
;; find-component
#:explain
#:perform
#:perform-with-restarts
#:input-files
#:output-files
;; action
#:explain
#:perform
#:perform-with-restarts
#:input-files
#:output-files
;; action
#:component-depends-on
#:component-self-dependencies
#:operation-done-p
#:component-depends-on
#:component-self-dependencies
#:operation-done-p
...
@@ -51,7 +77,7 @@
...
@@ -51,7 +77,7 @@
#:apply-output-translations
;; output-translations
#:apply-output-translations
;; output-translations
#:process-output-translations-directive
#:process-output-translations-directive
#:inherit-source-registry
#:process-source-registry
;; source-registry
#:inherit-source-registry
#:process-source-registry
;; source-registry
#:process-source-registry-directive
#:process-source-registry-directive
#:trivial-system-p
;; bundle
#:trivial-system-p
;; bundle
;; NB: it's too late to do anything about asdf-driver functions!
;; NB: it's too late to do anything about asdf-driver functions!
))
))
...
@@ -61,93 +87,57 @@
...
@@ -61,93 +87,57 @@
#:resolve-relative-location-component
#:resolve-absolute-location-component
#:resolve-relative-location-component
#:resolve-absolute-location-component
#:output-files-for-system-and-operation
)))
; obsolete ASDF-BINARY-LOCATION function
#:output-files-for-system-and-operation
)))
; obsolete ASDF-BINARY-LOCATION function
(
declare
(
ignorable
redefined-functions
uninterned-symbols
))
(
declare
(
ignorable
redefined-functions
uninterned-symbols
))
(
setf
*asdf-version*
asdf-version
)
(
loop
:for
name
:in
(
append
#-
(
or
clisp
ecl
)
redefined-functions
)
(
when
(
and
existing-asdf
(
not
already-there
))
:for
sym
=
(
find-symbol*
name
:asdf
nil
)
:do
(
push
existing-version
*upgraded-p*
)
(
when
sym
(
when
*asdf-verbose*
(
fmakunbound
sym
)))
(
format
*trace-output*
(
loop
:with
asdf
=
(
find-package
:asdf
)
(
compatfmt
"~&~@<; ~@;Upgrading ASDF ~@[from version ~A ~]to version ~A~@:>~%"
)
:for
name
:in
(
append
#+
(
or
clisp
ecl
)
redefined-functions
uninterned-symbols
)
;XXX
existing-version
asdf-version
))
:for
sym
=
(
find-symbol*
name
:asdf
nil
)
(
loop
:for
name
:in
(
append
#-
(
or
clisp
ecl
)
redefined-functions
)
:for
base-pkg
=
(
and
sym
(
symbol-package
sym
))
:do
:for
sym
=
(
find-symbol*
name
:asdf
nil
)
:do
(
when
sym
(
when
sym
(
cond
;;(format t "Undefining ~S~%" sym);XXX
((
or
(
eq
base-pkg
asdf
)
(
not
base-pkg
))
(
fmakunbound
sym
)))
(
unintern*
sym
asdf
)
(
loop
:with
asdf
=
(
find-package
:asdf
)
(
intern*
sym
asdf
))
:for
name
:in
(
append
#+
(
or
clisp
ecl
)
redefined-functions
uninterned-symbols
)
;XXX
(
t
:for
sym
=
(
find-symbol*
name
:asdf
nil
)
(
unintern*
sym
base-pkg
)
:for
base-pkg
=
(
and
sym
(
symbol-package
sym
))
:do
(
let
((
new
(
intern*
sym
base-pkg
)))
(
when
sym
(
shadowing-import
new
asdf
))))))))
;;(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
"-"
))))))
;;;
Upgrade interface
;;;
Self-upgrade functions
(
defun*
asdf-upgrade-error
()
(
defun*
asdf-upgrade-error
()
;; Important notice for whom it concerns. The crux of the matter is that
;; 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.
;; 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)~%~
(
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.~%"
))
Otherwise, when you upgrade from ASDF 2, 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*
)
;;; Self-upgrade functions
(
defun*
cleanup-upgraded-asdf
(
&optional
(
old-version
(
first
*previous-asdf-versions*
)))
(
defvar
*post-upgrade-cleanup-hook*
())
(
defvar
*post-upgrade-restart-hook*
())
(
defun*
cleanup-upgraded-asdf
(
old-version
)
(
let
((
new-version
(
asdf-version
)))
(
let
((
new-version
(
asdf-version
)))
(
unless
(
equal
old-version
new-version
)
(
unless
(
equal
old-version
new-version
)
(
cond
(
push
new-version
*previous-asdf-versions*
)
((
version-compatible-p
new-version
old-version
)
(
when
old-version
(
asdf-message
(
compatfmt
"~&~@<; ~@;Upgraded ASDF from version ~A to version ~A~@:>~%"
)
(
cond
old-version
new-version
))
((
version-compatible-p
new-version
old-version
)
((
version-compatible-p
old-version
new-version
)
(
asdf-message
(
compatfmt
"~&~@<; ~@;Upgraded ASDF from version ~A to version ~A~@:>~%"
)
(
warn
(
compatfmt
"~&~@<; ~@;Downgraded ASDF from version ~A to version ~A~@:>~%"
)
old-version
new-version
))
old-version
new-version
))
((
version-compatible-p
old-version
new-version
)
(
t
(
warn
(
compatfmt
"~&~@<; ~@;Downgraded ASDF from version ~A to version ~A~@:>~%"
)
(
asdf-message
(
compatfmt
"~&~@<; ~@;Changed ASDF from version ~A to incompatible version ~A~@:>~%"
)
old-version
new-version
))
old-version
new-version
)))
(
t
(
dolist
(
h
(
reverse
*post-upgrade-cleanup-hook*
))
(
asdf-message
(
compatfmt
"~&~@<; ~@;Changed ASDF from version ~A to incompatible version ~A~@:>~%"
)
(
funcall
(
ensure-function
h
)))
old-version
new-version
)))
(
dolist
(
h
*post-upgrade-restart-hook*
)
(
call-functions
(
reverse
*post-upgrade-cleanup-hook*
))
(
funcall
(
ensure-function
h
)))
t
))))
t
)))
(
defun*
upgrade-asdf
()
(
defun*
upgrade-asdf
()
"Try to upgrade of ASDF. If a different version was used, return T.
"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."
We need do that before we operate on anything that may possibly depend on ASDF."
(
let
((
version
(
asdf-version
))
(
let
((
*load-print*
nil
)
(
*load-print*
nil
)
(
*compile-print*
nil
))
(
*compile-print*
nil
))
(
handler-bind
(((
or
style-warning
warning
)
#'
muffle-warning
))
(
handler-bind
(((
or
style-warning
warning
)
#'
muffle-warning
))
(
symbol-call
:asdf
:load-system
:asdf
:verbose
nil
))
(
symbol-call
:asdf
:load-system
:asdf
:verbose
nil
))))
(
cleanup-upgraded-asdf
version
)))
(
register-hook-function
'*post-upgrade-cleanup-hook*
'upgrade-configuration
)
utility.lisp
View file @
ab797258
...
@@ -308,7 +308,7 @@ instead of a list."
...
@@ -308,7 +308,7 @@ instead of a list."
(
defun*
call-functions
(
function-specs
)
(
defun*
call-functions
(
function-specs
)
(
map
()
'call-function
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
))
(
pushnew
hook
(
symbol-value
variable
))
(
when
call-now-p
(
call-function
hook
)))
(
when
call-now-p
(
call-function
hook
)))
...
@@ -372,8 +372,8 @@ with later being determined by a lexicographical comparison of minor numbers."
...
@@ -372,8 +372,8 @@ with later being determined by a lexicographical comparison of minor numbers."
#+
allegro
'excl::format-control
#+
allegro
'excl::format-control
#+
clisp
'system::$format-control
#+
clisp
'system::$format-control
#+
clozure
'ccl::format-control
#+
clozure
'ccl::format-control
#+
ecl
'si::format-control
#+
(
or
cmu
scl
)
'conditions::format-control
#+
(
or
cmu
scl
)
'conditions::format-control
#+
ecl
'si::format-control
#+
(
or
gcl
lispworks
)
'conditions::format-string
#+
(
or
gcl
lispworks
)
'conditions::format-string
#+
sbcl
'sb-kernel:format-control
#+
sbcl
'sb-kernel:format-control
#-
(
or
abcl
allegro
clisp
clozure
cmu
ecl
gcl
lispworks
sbcl
scl
)
nil
#-
(
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