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
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
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
Jan Moringen
asdf
Commits
50b839d3
Commit
50b839d3
authored
Oct 26, 2017
by
Robert Goldman
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'stamp' into 'master'
Rename stamp to timestamp in uiop/utility See merge request
asdf/asdf!87
parents
c380acd1
c6654583
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
35 additions
and
31 deletions
+35
-31
contrib/debug-plan.lisp
contrib/debug-plan.lisp
+5
-5
find-system.lisp
find-system.lisp
+2
-2
plan.lisp
plan.lisp
+6
-6
test/script-support.lisp
test/script-support.lisp
+4
-0
test/test-read-depends.script
test/test-read-depends.script
+2
-2
uiop/utility.lisp
uiop/utility.lisp
+16
-16
No files found.
contrib/debug-plan.lisp
View file @
50b839d3
...
...
@@ -61,7 +61,7 @@
(
in-files
(
input-files
o
c
))
(
in-stamps
(
mapcar
#'
get-file-stamp
in-files
))
(
missing-in
(
loop
:for
f
:in
in-files
:for
s
:in
in-stamps
:unless
s
:collect
f
))
(
latest-in
(
stamps-latest
(
cons
dep-stamp
in-stamps
))))
(
latest-in
(
time
stamps-latest
(
cons
dep-stamp
in-stamps
))))
(
when
(
and
missing-in
(
not
just-done
))
(
DBG
"compute-action-stamp: missing inputs"
(
cons
o
c
)
missing-in
)
(
return
(
values
nil
nil
))))
...
...
@@ -69,18 +69,18 @@
(
out-files
(
remove-if
'null
(
output-files
o
c
)))
(
out-stamps
(
mapcar
(
if
just-done
'register-file-stamp
'get-file-stamp
)
out-files
))
(
missing-out
(
loop
:for
f
:in
out-files
:for
s
:in
out-stamps
:unless
s
:collect
f
))
(
earliest-out
(
stamps-earliest
out-stamps
)))
(
earliest-out
(
time
stamps-earliest
out-stamps
)))
(
when
(
and
missing-out
(
not
just-done
))
(
DBG
"compute-action-stamp: missing outputs"
(
cons
o
c
)
missing-out
)
(
return
(
values
nil
nil
))))
(
let
(
;; Time stamps from the files at hand, and whether any is missing
(
all-present
(
not
(
or
missing-in
missing-out
)))
;; Has any input changed since we last generated the files?
;; Note that we use
stamp<= instead of
stamp< to play nice with generated files.
;; Note that we use
timestamp<= instead of time
stamp< to play nice with generated files.
;; Any race condition is intrinsic to the limited timestamp resolution.
(
up-to-date-p
(
stamp<=
latest-in
earliest-out
))
(
up-to-date-p
(
time
stamp<=
latest-in
earliest-out
))
;; If everything is up to date, the latest of inputs and outputs is our stamp
(
done-stamp
(
stamps-latest
(
cons
latest-in
out-stamps
))))
(
done-stamp
(
time
stamps-latest
(
cons
latest-in
out-stamps
))))
;; Warn if some files are missing:
;; either our model is wrong or some other process is messing with our files.
(
when
(
and
just-done
(
not
all-present
))
...
...
find-system.lisp
View file @
50b839d3
...
...
@@ -242,7 +242,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(
let
((
o
(
make-operation
'define-op
)))
(
multiple-value-bind
(
stamp
done-p
)
(
compute-action-stamp
plan
o
system
)
(
return
(
and
(
stamp<=
stamp
(
component-operation-time
o
system
))
(
return
(
and
(
time
stamp<=
stamp
(
component-operation-time
o
system
))
done-p
)))))
(
system-out-of-date
()
nil
)))
...
...
@@ -269,7 +269,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(
pathname-equal
(
physicalize-pathname
pathname
)
(
physicalize-pathname
previous-pathname
))))
(
stamp<=
stamp
previous-time
)
(
time
stamp<=
stamp
previous-time
)
;; TODO: check that all dependencies are up-to-date.
;; This necessitates traversing them without triggering
;; the adding of nodes to the plan.
...
...
plan.lisp
View file @
50b839d3
...
...
@@ -139,7 +139,7 @@ or NIL if no the status is considered outside of a specific plan."))
"Return the earliest status later than both status1 and status2"
(
make-action-status
:bits
(
logand
(
status-bits
status1
)
(
status-bits
status2
))
:stamp
(
latest-stamp
(
status-stamp
status1
)
(
status-stamp
status2
))
:stamp
(
latest-
time
stamp
(
status-stamp
status1
)
(
status-stamp
status2
))
:level
(
min
(
status-level
status1
)
(
status-level
status2
))
:index
(
or
(
status-index
status1
)
(
status-index
status2
))))
...
...
@@ -292,22 +292,22 @@ initialized with SEED."
(
in-files
(
input-files
o
c
))
(
in-stamps
(
mapcar
#'
get-file-stamp
in-files
))
(
missing-in
(
loop
:for
f
:in
in-files
:for
s
:in
in-stamps
:unless
s
:collect
f
))
(
latest-in
(
stamps-latest
(
cons
dep-stamp
in-stamps
))))
(
latest-in
(
time
stamps-latest
(
cons
dep-stamp
in-stamps
))))
(
when
(
and
missing-in
(
not
just-done
))
(
return
(
values
nil
nil
))))
(
let*
(
;; collect timestamps from outputs, and exit early if any is missing
(
out-files
(
remove-if
'null
(
output-files
o
c
)))
(
out-stamps
(
mapcar
(
if
just-done
'register-file-stamp
'get-file-stamp
)
out-files
))
(
missing-out
(
loop
:for
f
:in
out-files
:for
s
:in
out-stamps
:unless
s
:collect
f
))
(
earliest-out
(
stamps-earliest
out-stamps
)))
(
earliest-out
(
time
stamps-earliest
out-stamps
)))
(
when
(
and
missing-out
(
not
just-done
))
(
return
(
values
nil
nil
))))
(
let
(
;; Time stamps from the files at hand, and whether any is missing
(
all-present
(
not
(
or
missing-in
missing-out
)))
;; Has any input changed since we last generated the files?
;; Note that we use
stamp<= instead of
stamp< to play nice with generated files.
;; Note that we use
timestamp<= instead of time
stamp< to play nice with generated files.
;; Any race condition is intrinsic to the limited timestamp resolution.
(
up-to-date-p
(
stamp<=
latest-in
earliest-out
))
(
up-to-date-p
(
time
stamp<=
latest-in
earliest-out
))
;; If everything is up to date, the latest of inputs and outputs is our stamp
(
done-stamp
(
stamps-latest
(
cons
latest-in
out-stamps
))))
(
done-stamp
(
time
stamps-latest
(
cons
latest-in
out-stamps
))))
;; Warn if some files are missing:
;; either our model is wrong or some other process is messing with our files.
(
when
(
and
just-done
(
not
all-present
))
...
...
test/script-support.lisp
View file @
50b839d3
...
...
@@ -687,6 +687,10 @@ is bound, write a message and exit on an error. If
(
format
t
"CR ~S~%"
(
symbol-value
(
asym
:*central-registry*
)))
(
format
t
"loading test-module-depend~%"
)
(
acall
:oos
(
asym
:load-op
)
:test-module-depend
)
(
assert-equal
(
asymval
:*f2c*
:test-package
)
1
)
(
format
t
"loading test-module-depend again -- shouldn't rebuild anything~%"
)
(
acall
:oos
(
asym
:load-op
)
:test-module-depend
)
(
assert-equal
(
asymval
:*f2c*
:test-package
)
1
)
(
format
t
"done loading~%"
))
(
defun
load-asdf
(
&optional
tag
)
...
...
test/test-read-depends.script
View file @
50b839d3
...
...
@@ -54,7 +54,7 @@
;; (trace asdf/action::component-operation-time)
;; #+allegro #+allegro
;; (trace (asdf:input-files :inside asdf/plan::compute-action-stamp)
;; (asdf/plan::stamp<= :inside asdf/plan::compute-action-stamp)
;; (asdf/plan::
time
stamp<= :inside asdf/plan::compute-action-stamp)
;; (asdf/plan::get-file-stamp :inside asdf/plan::compute-action-stamp))
;;; bump the version
...
...
@@ -91,7 +91,7 @@
:inside asdf:find-system)
(asdf/find-system::get-file-stamp
:inside find-system)
(asdf/find-system::stamp<=
(asdf/find-system::
time
stamp<=
:inside find-system))
;; AFAICT, the :WHEREIN in SBCL TRACE does not work
;; properly. In my copious free time, I should see if I
...
...
uiop/utility.lisp
View file @
50b839d3
...
...
@@ -25,9 +25,9 @@
#:string-prefix-p
#:string-enclosed-p
#:string-suffix-p
#:standard-case-symbol-name
#:find-standard-case-symbol
;; symbols
#:coerce-class
;; CLOS
#:
stamp<
#:stamps<
#:stamp*<
#:stamp<=
;;
stamps
#:earlier-
stamp
#:stamps-earliest
#:earliest-
stamp
#:later-
stamp
#:stamps-latest
#:latest-stamp
#:latest-
stamp-f
#:
timestamp<
#:timestamps<
#:timestamp*<
#:timestamp<=
;; time
stamps
#:earlier-
timestamp
#:timestamps-earliest
#:earliest-time
stamp
#:later-
timestamp
#:timestamps-latest
#:latest-timestamp
#:latest-time
stamp-f
#:list-to-hash-set
#:ensure-gethash
;; hash-table
#:ensure-function
#:access-at
#:access-at-count
;; functions
#:call-function
#:call-functions
#:register-hook-function
...
...
@@ -375,11 +375,11 @@ If optional ERROR argument is NIL, return NIL instead of an error when the symbo
(
string
(
standard-case-symbol-name
package-designator
)))
error
)))
;;; stamps: a REAL or a boolean where T=-infinity, NIL=+infinity
;;;
time
stamps: a REAL or a boolean where T=-infinity, NIL=+infinity
(
eval-when
(
#-
lispworks
:compile-toplevel
:load-toplevel
:execute
)
(
deftype
stamp
()
'
(
or
real
boolean
)))
(
deftype
time
stamp
()
'
(
or
real
boolean
)))
(
with-upgradability
()
(
defun
stamp<
(
x
y
)
(
defun
time
stamp<
(
x
y
)
(
etypecase
x
((
eql
t
)
(
not
(
eql
y
t
)))
(
real
(
etypecase
y
...
...
@@ -387,16 +387,16 @@ If optional ERROR argument is NIL, return NIL instead of an error when the symbo
(
real
(
<
x
y
))
(
null
t
)))
(
null
nil
)))
(
defun
stamps<
(
list
)
(
loop
:for
y
:in
list
:for
x
=
nil
:then
y
:always
(
stamp<
x
y
)))
(
defun
stamp*<
(
&rest
list
)
(
stamps<
list
))
(
defun
stamp<=
(
x
y
)
(
not
(
stamp<
y
x
)))
(
defun
earlier-
stamp
(
x
y
)
(
if
(
stamp<
x
y
)
x
y
))
(
defun
stamps-earliest
(
list
)
(
reduce
'earlier-
stamp
list
:initial-value
nil
))
(
defun
earliest-
stamp
(
&rest
list
)
(
stamps-earliest
list
))
(
defun
later-
stamp
(
x
y
)
(
if
(
stamp<
x
y
)
y
x
))
(
defun
stamps-latest
(
list
)
(
reduce
'later-
stamp
list
:initial-value
t
))
(
defun
latest-
stamp
(
&rest
list
)
(
stamps-latest
list
))
(
define-modify-macro
latest-
stamp-f
(
&rest
stamps
)
latest-
stamp
))
(
defun
timestamps<
(
list
)
(
loop
:for
y
:in
list
:for
x
=
nil
:then
y
:always
(
time
stamp<
x
y
)))
(
defun
timestamp*<
(
&rest
list
)
(
time
stamps<
list
))
(
defun
timestamp<=
(
x
y
)
(
not
(
time
stamp<
y
x
)))
(
defun
earlier-
timestamp
(
x
y
)
(
if
(
time
stamp<
x
y
)
x
y
))
(
defun
timestamps-earliest
(
list
)
(
reduce
'earlier-time
stamp
list
:initial-value
nil
))
(
defun
earliest-
timestamp
(
&rest
list
)
(
time
stamps-earliest
list
))
(
defun
later-
timestamp
(
x
y
)
(
if
(
time
stamp<
x
y
)
y
x
))
(
defun
timestamps-latest
(
list
)
(
reduce
'later-time
stamp
list
:initial-value
t
))
(
defun
latest-
timestamp
(
&rest
list
)
(
time
stamps-latest
list
))
(
define-modify-macro
latest-
timestamp-f
(
&rest
timestamps
)
latest-time
stamp
))
;;; Function designators
...
...
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