Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
asdf
asdf
Commits
1dc29342
Commit
1dc29342
authored
Dec 09, 2012
by
Francois-Rene Rideau
Browse files
2.26.15: more twiddling of compute-action-stamp. POIU works again at long last!
parent
3ea3f701
Changes
3
Hide whitespace changes
Inline
Side-by-side
asdf.asd
View file @
1dc29342
...
...
@@ -14,7 +14,7 @@
:licence
"MIT"
:description
"Another System Definition Facility"
:long-description
"ASDF builds Common Lisp software organized into defined systems."
:version
"2.26.1
4
"
;; to be automatically updated by bin/bump-revision
:version
"2.26.1
5
"
;; to be automatically updated by bin/bump-revision
:depends-on
()
:components
((
:file
"asdf"
)))
...
...
asdf.lisp
View file @
1dc29342
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
;;; This is ASDF 2.26.1
4
: Another System Definition Facility.
;;; This is ASDF 2.26.1
5
: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
...
...
@@ -118,7 +118,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.1
4
"
)
(
asdf-version
"2.26.1
5
"
)
(
existing-asdf
(
find-class
'component
nil
))
(
existing-version
*asdf-version*
)
(
already-there
(
equal
asdf-version
existing-version
)))
...
...
@@ -2049,13 +2049,6 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(
defmethod
component-visited-p
((
o
operation
)
(
c
component
))
(
gethash
(
node-for
o
c
)
(
operation-visited-nodes
(
operation-ancestor
o
))))
(
defun*
component-visited-stamp
(
o
c
)
(
let
((
data
(
component-visited-p
o
c
)))
(
cond
(
data
(
car
data
))
(
t
;;(when *asdf-verbose* (warn "looking up stamp for non-visited dependency: ~A ~A" o c))
nil
))))
(
defun*
call-with-component-being-visited
(
o
c
fun
)
;; Detect circular dependencies
(
let*
((
node
(
node-for
o
c
))
...
...
@@ -2130,7 +2123,9 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(
defmethod
component-operation-time
((
o
operation
)
(
c
component
))
(
gethash
(
type-of
o
)
(
component-operation-times
c
)))
(
defgeneric*
compute-action-stamp
(
operation
component
&key
mode
base-stamp
)
(
defgeneric*
action-visited-stamp
(
plan
operation
component
))
(
defgeneric*
compute-action-stamp
(
operation
component
&key
just-done
plan
base-stamp
)
(
:documentation
"Has this action been done, and at what timestamp has it or will it be done?
Takes two keywords JUST-DONE and STAMP-LOOKUP:
JUST-DONE is a boolean that is true if the action was just successfully performed,
...
...
@@ -2264,7 +2259,7 @@ Returns two values:
(
defvar
*visit-count*
0
)
; counter that allows to sort nodes from operation-visited-nodes
(
defun*
visit-action
(
o
c
recurse
fun
base-stamp
)
(
defun*
visit-action
(
o
c
base-stamp
plan
recurse
fun
)
(
block
nil
;; Systems don't inherit force, but use operation-forced{,-not}.
(
let*
((
force
...
...
@@ -2287,7 +2282,7 @@ Returns two values:
(
visit-module-components
o
c
(
funcall
recurse
(
later-stamp
force
dep-stamp
)))))
(
multiple-value-bind
(
stamp
done-p
)
(
compute-action-stamp
o
c
:
mode
:
plan
o
c
:
plan
plan
:base-stamp
(
latest-stamp
force
dep-stamp
components-stamp
))
(
funcall
fun
o
c
done-p
stamp
)
stamp
))))
...
...
@@ -2301,26 +2296,28 @@ Returns two values:
(
when
p
(
return
(
car
s
))))
(
with-component-being-visited
(
o
c
)
(
visit-action
o
c
o
c
base-stamp
'traverse
#'
(
lambda
(
stamp
)
#'
(
lambda
(
o
c
)
(
traverse-action
o
c
stamp
collect
)))
#'
(
lambda
(
o
c
done-p
stamp
)
(
mark-component-visited
o
c
(
cons
stamp
(
unless
done-p
(
incf
*visit-count*
))))
(
if
done-p
(
mark-operation-done
o
c
)
(
do-collect
collect
(
cons
o
c
))))
base-stamp
))))
(
do-collect
collect
(
cons
o
c
))))))))
(
defmethod
traverse
((
o
operation
)
(
c
component
))
(
while-collecting
(
collect
)
(
let
((
*visit-count*
0
))
(
traverse-action
o
c
nil
#'
collect
))))
(
defmethod
compute-action-stamp
((
o
operation
)
(
c
component
)
&key
(
mode
:query
)
base-stamp
)
(
let*
((
stamp-lookup
(
ecase
mode
((
:just-done
:query
)
'component-operation-time
)
((
:plan
)
'component-visited-stamp
)))
(
just-done
(
eq
mode
:just-done
))
(
defmethod
action-visited-stamp
((
plan
null
)
(
o
operation
)
(
c
component
))
(
component-operation-time
o
c
))
(
defmethod
action-visited-stamp
((
plan
(
eql
'traverse
))
(
o
operation
)
(
c
component
))
(
car
(
component-visited-p
o
c
)))
(
defmethod
compute-action-stamp
((
o
operation
)
(
c
component
)
&key
just-done
plan
base-stamp
)
(
let*
((
stamp-lookup
#'
(
lambda
(
o
c
)
(
action-visited-stamp
plan
o
c
)))
(
out-files
(
output-files
o
c
))
(
in-files
(
input-files
o
c
))
(
file-op
(
and
out-files
t
))
...
...
@@ -2357,7 +2354,7 @@ Returns two values:
(
and
(
stamp<=
latest-in
earliest-out
)
(
operation-done-p
o
c
)))
(
values
done-stamp
(
and
(
or
op-
time
out-files
(
and
(
null
in-files
)
(
null
out-files
))
)
(
and
(
or
op-
stamp
file-op
null-op
)
(
if
(
realp
op-stamp
)
(
eql
op-stamp
done-stamp
)
t
)
all-present
))
(
values
t
nil
))))
...
...
@@ -2373,7 +2370,7 @@ Returns two values:
(
defmethod
mark-operation-done
((
o
operation
)
(
c
component
))
(
setf
(
gethash
(
type-of
o
)
(
component-operation-times
c
))
(
compute-action-stamp
o
c
:mode
:just-done
)))
(
compute-action-stamp
o
c
:just-done
t
)))
(
defmethod
perform-with-restarts
(
operation
component
)
;; TOO verbose, especially as the default. Add your own :before method
...
...
@@ -2583,6 +2580,11 @@ Returns two values:
(
declare
(
ignorable
o
))
(
format
nil
(
compatfmt
"~@<loaded ~3i~_~A~@:>"
)
c
))
(
defmethod
operation-description
((
o
parent-load-op
)
(
c
component
))
(
declare
(
ignorable
o
))
(
format
nil
(
compatfmt
"~@<loading dependencies of ~3i~_~A~@:>"
)
c
))
;;;; -------------------------------------------------------------------------
;;;; load-source-op
...
...
@@ -2621,6 +2623,10 @@ Returns two values:
(
declare
(
ignorable
o
))
(
format
nil
(
compatfmt
"~@<Loaded source of ~3i~_~A~@:>"
)
c
))
(
defmethod
operation-description
((
o
parent-load-source-op
)
(
c
component
))
(
declare
(
ignorable
o
))
(
format
nil
(
compatfmt
"~@<loading source for dependencies of ~3i~_~A~@:>"
)
c
))
;;;; -------------------------------------------------------------------------
;;;; test-op
...
...
@@ -2666,6 +2672,7 @@ Returns two values:
;; Invalidate all systems but ASDF itself.
(
setf
*defined-systems*
(
make-defined-systems-table
))
(
register-system
asdf
)
(
funcall
(
find-symbol*
'load-system
:asdf
)
:asdf
)
;; do it a second time, the right way.
;; If we're in the middle of something, restart it.
(
when
*systems-being-defined*
(
let
((
l
(
loop
:for
name
:being
:the
:hash-keys
:of
*systems-being-defined*
:collect
name
)))
...
...
@@ -4818,9 +4825,9 @@ with a different configuration, so the configuration would be re-read then."
(
if
(
bundle-op-monolithic-p
o
)
(
values
'monolithic-lib-op
'monolithic-fasl-op
)
(
values
'lib-op
'fasl-op
))
(
list
(
list
(
make-
sub-operation
o
lib-op
:args
(
bundle-op-build-args
o
))
(
list
(
list
(
make-
instance
lib-op
:parent
o
:args
(
bundle-op-build-args
o
))
s
)
(
list
(
make-
sub-operation
o
fasl-op
:args
(
bundle-op-build-args
o
))
(
list
(
make-
instance
fasl-op
:parent
o
:args
(
bundle-op-build-args
o
))
s
))))
(
defmethod
component-depends-on
((
o
binary-op
)
(
s
system
))
...
...
test/script-support.lisp
View file @
1dc29342
...
...
@@ -56,6 +56,7 @@
(
defun
load-asdf
()
(
load
*asdf-fasl*
)
(
use-package
:asdf
:asdf-test
)
(
import
'DBG
:asdf
)
(
setf
*package*
(
find-package
:asdf-test
)))
(
defun
common-lisp-user::load-asdf
()
...
...
@@ -187,7 +188,6 @@ is bound, write a message and exit on an error. If
(
defmacro
test-asdf
(
&body
body
)
`
(
testing-asdf
#'
(
lambda
()
,@
body
)))
#|
(
defmacro
DBG
(
tag
&rest
exprs
)
"simple debug statement macro:
outputs a tag plus a list of variable and their values, returns the last value"
...
...
@@ -204,5 +204,8 @@ outputs a tag plus a list of variable and their values, returns the last value"
exprs
)
(
apply
'values
,
res
)))))
(DBG :cas o c just-done base-stamp stamp-lookup out-files in-files file-op null-op op-time dep-stamp out-stamps in-stamps missing-in missing-out all-present earliest-out latest-in done-stamp (stamp<= latest-in earliest-out) (operation-done-p o c))
(
pushnew
:DBG
*features*
)
#|
#+DBG (DBG :cas o c just-done base-stamp stamp-lookup out-files in-files file-op null-op op-time op-stamp dep-stamp out-stamps in-stamps missing-in missing-out all-present earliest-out latest-in done-stamp (stamp<= latest-in earliest-out) (operation-done-p o c))
|#
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