Commit e7b8ba73 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Fix compute-action-stamp when stamp is NIL

Stop unnecessarily re-performing initial input-less actions.

Also fix (setf (action-status nil o c) ...),
which therefore seems not to have been previously used.
parent 79638a7d
(in-package :asdf/plan)
;; NB: Whenever compute-action-stamp is changed, this file must be updated
;; to insert the let-and-DBG statements in the current version of the function.
;; So if you find this file not working, it might be out of date.
(uiop:uiop-debug)
(progn
......@@ -13,14 +17,15 @@
;; in the current image, or NIL if it hasn't.
;; Note that if e.g. LOAD-OP only depends on up-to-date files, but
;; hasn't been done in the current image yet, then it can have a non-T timestamp,
;; yet a NIL done-in-image-p flag.
;; yet a NIL done-in-image-p flag: we can predict what timestamp it will have once loaded,
;; i.e. that of the input-files.
(nest
(block ())
(let ((dep-stamp ; collect timestamp from dependencies (or T if forced or out-of-date)
(reduce-direct-dependencies
plan o c
o c
#'(lambda (o c stamp)
(if-let (it (plan-action-status plan o c))
(if-let (it (action-status plan o c))
(latest-stamp stamp (action-stamp it))
t))
nil)))
......@@ -28,9 +33,9 @@
(when (and (eq dep-stamp t) (not just-done))
(let ((outdated-deps
(reduce-direct-dependencies
plan o c
o c
#'(lambda (o c deps)
(if (if-let (it (plan-action-status plan o c))
(if (if-let (it (action-status plan o c))
(not (eq t (action-stamp it))))
deps
(cons (cons o c) deps)))
......@@ -54,34 +59,38 @@
(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)))
(when (and missing-out (not just-done))
(DBG "compute-action-stamp: missing outputs"
(cons o c)
missing-out)
(return (values t nil))))
(let* (;; There are three kinds of actions:
(out-op (and out-files t)) ; those that create files on the filesystem
;;(image-op (and in-files (null out-files))) ; those that load stuff into the image
;;(null-op (and (null out-files) (null in-files))) ; placeholders that do nothing
;; When was the thing last actually done? (Now, or ask.)
(op-time (or just-done (component-operation-time o c)))
;; 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?
(up-to-date-p (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))))
(when (and missing-out (not just-done)) (return (values t 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?
(up-to-date-p (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))))
;; 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))
;; Shouldn't that be an error instead?
(warn "~A completed without ~:[~*~;~*its input file~:p~2:*~{ ~S~}~*~]~
~:[~; or ~]~:[~*~;~*its output file~:p~2:*~{ ~S~}~*~]"
(action-description o c)
missing-in (length missing-in) (and missing-in missing-out)
missing-out (length missing-out)))
(let ((already-done-p (and all-present up-to-date-p (operation-done-p o c) (not (action-forced-p plan o c))))
(matching-stamp-p (and op-time (eql op-time done-stamp))))
(DBG "compute-action-stamp"
missing-out (length missing-out))))
(let (;; There are three kinds of actions:
(out-op (and out-files t)) ; those that create files on the filesystem
;;(image-op (and in-files (null out-files))) ; those that load stuff into the image
;;(null-op (and (null out-files) (null in-files))) ; placeholders that do nothing
))
;; Status of the action as previously performed in the image
(multiple-value-bind (perform-stamp perform-done-p)
(if just-done
(values done-stamp t)
(component-operation-time o c)))
;; Note that we use stamp<= instead of stamp< to play nice with generated files.
;; Any race condition is intrinsic to the limited timestamp resolution.
(let ((already-done-p (and all-present up-to-date-p (operation-done-p o c)
(not (action-forced-p (forcing (or plan *asdf-session*)) o c))))
(matching-stamp-p (and perform-done-p (eql perform-stamp done-stamp))))
(DBG "compute-action-stamp"
(cons o c)
in-files
in-stamps
......@@ -91,23 +100,24 @@
latest-in
earliest-out
up-to-date-p
op-time
perform-stamp
perform-done-p
done-stamp
;; (eql op-time done-stamp)
all-present
already-done-p
just-done
out-op
matching-stamp-p)))
matching-stamp-p))
;; Note that we use stamp<= instead of stamp< to play nice with generated files.
;; Any race condition is intrinsic to the limited timestamp resolution.
(if (or just-done ;; The done-stamp is valid: if we're just done, or
;; if all filesystem effects are up-to-date and there's no invalidating reason.
(and all-present up-to-date-p (operation-done-p o c) (not (action-forced-p plan o c))))
(and all-present up-to-date-p (operation-done-p o c)
(not (action-forced-p (forcing (or plan *asdf-session*)) o c))))
(values done-stamp ;; return the hard-earned timestamp
(or just-done
out-op ;; a file-creating op is done when all files are up to date
;; a image-effecting a placeholder op is done when it was actually run,
(and op-time (eql op-time done-stamp)))) ;; with the matching stamp
(and perform-done-p (equal perform-stamp done-stamp)))) ;; with the matching stamp
;; done-stamp invalid: return a timestamp in an indefinite future, action not done yet
(values t nil)))))
......@@ -9,7 +9,6 @@
:asdf/component :asdf/operation :asdf/action :asdf/lisp-action
:asdf/system :asdf/system-registry :asdf/find-component :asdf/forcing)
(:export
#:component-operation-time
#:plan #:plan-traversal #:sequential-plan #:*plan-class*
#:action-status #:action-stamp #:action-done-p #:action-index #:action-planned-p
#:action-already-done-p #:+action-status-out-of-date+
......@@ -92,8 +91,8 @@ the action of OPERATION on COMPONENT in the PLAN"))
(defmethod (setf action-status) (new-status (plan null) (o operation) (c component))
(let ((times (component-operation-times c)))
(if (action-done-p new-status)
(remhash o times)
(setf (gethash o times) (action-stamp new-status))))
(setf (gethash o times) (action-stamp new-status))
(remhash o times)))
new-status))
......@@ -178,26 +177,31 @@ initialized with SEED."
(missing-out (loop :for f :in out-files :for s :in out-stamps :unless s :collect f))
(earliest-out (stamps-earliest out-stamps)))
(when (and missing-out (not just-done)) (return (values t nil))))
(let* (;; There are three kinds of actions:
(out-op (and out-files t)) ; those that create files on the filesystem
;;(image-op (and in-files (null out-files))) ; those that load stuff into the image
;;(null-op (and (null out-files) (null in-files))) ; placeholders that do nothing
;; When was the thing last actually done? (Now, or ask.)
(op-time (or just-done (component-operation-time o c)))
;; 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?
(up-to-date-p (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))))
(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?
(up-to-date-p (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))))
;; 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))
;; Shouldn't that be an error instead?
(warn "~A completed without ~:[~*~;~*its input file~:p~2:*~{ ~S~}~*~]~
~:[~; or ~]~:[~*~;~*its output file~:p~2:*~{ ~S~}~*~]"
(action-description o c)
missing-in (length missing-in) (and missing-in missing-out)
missing-out (length missing-out))))
(let (;; There are three kinds of actions:
(out-op (and out-files t)) ; those that create files on the filesystem
;;(image-op (and in-files (null out-files))) ; those that load stuff into the image
;;(null-op (and (null out-files) (null in-files))) ; placeholders that do nothing
))
;; Status of the action as previously performed in the image
(multiple-value-bind (perform-stamp perform-done-p)
(if just-done
(values done-stamp t)
(component-operation-time o c)))
;; Note that we use stamp<= instead of stamp< to play nice with generated files.
;; Any race condition is intrinsic to the limited timestamp resolution.
(if (or just-done ;; The done-stamp is valid: if we're just done, or
......@@ -208,7 +212,7 @@ initialized with SEED."
(or just-done
out-op ;; a file-creating op is done when all files are up to date
;; a image-effecting a placeholder op is done when it was actually run,
(and op-time (eql op-time done-stamp)))) ;; with the matching stamp
(and perform-done-p (equal perform-stamp done-stamp)))) ;; with the matching stamp
;; done-stamp invalid: return a timestamp in an indefinite future, action not done yet
(values t nil)))))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment