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
Didier Verna
asdf
Commits
5e4e235b
Commit
5e4e235b
authored
Feb 06, 2013
by
Francois-Rene Rideau
Browse files
2.28.4: keep registered ASDF system to avoid double-upgrade.
Also, allow for unqualified inline-methods. Fixes lp#485393
parent
26e7a4f3
Changes
7
Hide whitespace changes
Inline
Side-by-side
asdf.asd
View file @
5e4e235b
...
...
@@ -74,7 +74,7 @@
:licence
"MIT"
:description
"Another System Definition Facility"
:long-description
"ASDF builds Common Lisp software organized into defined systems."
:version
"2.28.
3
"
;; to be automatically updated by make bump-version
:version
"2.28.
4
"
;; 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 @
5e4e235b
...
...
@@ -28,7 +28,6 @@
#'
(
lambda
(
m
)
(
remove-method
(
symbol-function
name
)
m
))
(
component-inline-methods
component
)))
;; clear methods, then add the new ones
(
component-inline-methods
component
)
nil
)
(
defun
%define-component-inline-methods
(
ret
rest
)
...
...
@@ -39,13 +38,19 @@
:for
value
=
(
second
data
)
:while
data
:when
(
eq
key
keyword
)
:do
(
destructuring-bind
(
op
qual
(
o
c
)
&body
body
)
value
(
pushnew
(
eval
`
(
defmethod
,
name
,
qual
((
,
o
,
op
)
(
,
c
(
eql
,
ret
)))
,@
body
))
(
component-inline-methods
ret
)))))))
(
destructuring-bind
(
op
qual?
&rest
rest
)
value
(
multiple-value-bind
(
qual
args-and-body
)
(
if
(
symbolp
qual?
)
(
values
(
list
qual?
)
rest
)
(
values
nil
(
cons
qual?
rest
)))
(
destructuring-bind
((
o
c
)
&body
body
)
args-and-body
(
pushnew
(
eval
`
(
defmethod
,
name
,@
qual
((
,
o
,
op
)
(
,
c
(
eql
,
ret
)))
,@
body
))
(
component-inline-methods
ret
)))))))))
(
defun
%refresh-component-inline-methods
(
component
rest
)
;; clear methods, then add the new ones
(
%remove-component-inline-methods
component
)
(
%define-component-inline-methods
component
rest
)))
...
...
find-system.lisp
View file @
5e4e235b
...
...
@@ -57,18 +57,6 @@
(
error
'formatted-system-definition-error
:format-control
format
:format-arguments
arguments
))
(
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
))
...
...
@@ -81,6 +69,13 @@ of which is a system object.")
;; the first of the slash-separated components.
(
first
(
split-string
(
coerce-name
name
)
:separator
"/"
)))
(
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
system-registered-p
(
name
)
(
gethash
(
coerce-name
name
)
*defined-systems*
))
...
...
@@ -99,6 +94,17 @@ of which is a system object.")
(
get-file-stamp
file
))
system
)))))
(
defun
clear-defined-systems
()
;; Invalidate all systems but ASDF itself, if registered.
(
let
((
asdf
(
cdr
(
system-registered-p
:asdf
))))
(
setf
*defined-systems*
(
make-hash-table
:test
'equal
))
(
when
asdf
(
setf
(
component-version
asdf
)
*asdf-version*
)
(
register-system
asdf
)))
(
values
))
(
register-hook-function
'*post-upgrade-cleanup-hook*
'clear-defined-systems
nil
)
(
defun
clear-system
(
name
)
"Clear the entry for a system in the database of systems previously loaded.
Note that this does NOT in any way cause the code of the system to be unloaded."
...
...
header.lisp
View file @
5e4e235b
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.28.
3
: Another System Definition Facility.
;;; This is ASDF 2.28.
4
: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
...
...
test/test-inline-methods.script
View file @
5e4e235b
(defparameter *a* nil)
;;; -*- Lisp -*-
(defparameter *a* 0)
(def-test-system :foo
:components
((:file "file1" :perform (load-op :before (o c)
(setf *a* t)
(format t "Method run before ~A~%" (action-description o c))))))
((:file "file1"
:perform (load-op :before (o c)
(incf *a*)
(format t "Method run before ~A~%" (action-description o c))))
(:file "file2" :depends-on ("file1")
:perform (load-op (o c)
(incf *a*)
(format t "Method run for ~A~%" (action-description o c))
(call-next-method)))))
(load-system :foo)
(assert *a*)
(assert
-equal
*a*
2
)
upgrade.lisp
View file @
5e4e235b
...
...
@@ -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.28.
3
"
)
(
asdf-version
"2.28.
4
"
)
(
existing-version
(
asdf-version
)))
(
setf
*asdf-version*
asdf-version
)
(
when
(
and
existing-version
(
not
(
equal
asdf-version
existing-version
)))
...
...
version.lisp-expr
View file @
5e4e235b
"2.28.
3
"
"2.28.
4
"
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