Skip to content
Snippets Groups Projects
Commit 54c556e9 authored by Christophe Rhodes's avatar Christophe Rhodes
Browse files

A bit more robustness in the FILE-WRITE-DATE department. This version

is still subject to filesystem races (say, between probe-file and
file-write-date) but they're a lot less likely.  Attempt to do the
"right" thing if an input file has gone missing.
parent fb9cf03b
No related branches found
No related tags found
No related merge requests found
;;; This is asdf: Another System Definition Facility. $Revision: 1.94 $ ;;; This is asdf: Another System Definition Facility. $Revision: 1.95 $
;;; ;;;
;;; Feedback, bug reports, and patches are all welcome: please mail to ;;; Feedback, bug reports, and patches are all welcome: please mail to
;;; <cclan-list@lists.sf.net>. But note first that the canonical ;;; <cclan-list@lists.sf.net>. But note first that the canonical
...@@ -109,7 +109,7 @@ ...@@ -109,7 +109,7 @@
(in-package #:asdf) (in-package #:asdf)
(defvar *asdf-revision* (let* ((v "$Revision: 1.94 $") (defvar *asdf-revision* (let* ((v "$Revision: 1.95 $")
(colon (or (position #\: v) -1)) (colon (or (position #\: v) -1))
(dot (position #\. v))) (dot (position #\. v)))
(and v colon dot (and v colon dot
...@@ -583,26 +583,40 @@ system.")) ...@@ -583,26 +583,40 @@ system."))
(defmethod input-files ((operation operation) (c module)) nil) (defmethod input-files ((operation operation) (c module)) nil)
(defmethod operation-done-p ((o operation) (c component)) (defmethod operation-done-p ((o operation) (c component))
(let ((out-files (output-files o c)) (flet ((fwd-or-return-t (file)
(in-files (input-files o c))) ;; if FILE-WRITE-DATE returns NIL, it's possible that the
(cond ((and (not in-files) (not out-files)) ;; user or some other agent has deleted an input file. If
;; arbitrary decision: an operation that uses nothing to ;; that's the case, well, that's not good, but as long as
;; produce nothing probably isn't doing much ;; the operation is otherwise considered to be done we
t) ;; could continue and survive.
((not out-files) (let ((date (file-write-date file)))
(let ((op-done (cond
(gethash (type-of o) (date)
(component-operation-times c)))) (t
(and op-done (warn "~@<Missing FILE-WRITE-DATE for ~S: treating ~
(>= op-done operation ~S on component ~S as done.~@:>"
(or (apply #'max file o c)
(mapcar #'file-write-date in-files)) 0))))) (return-from operation-done-p t))))))
((not in-files) nil) (let ((out-files (output-files o c))
(t (in-files (input-files o c)))
(and (cond ((and (not in-files) (not out-files))
(every #'probe-file out-files) ;; arbitrary decision: an operation that uses nothing to
(> (apply #'min (mapcar #'file-write-date out-files)) ;; produce nothing probably isn't doing much
(apply #'max (mapcar #'file-write-date in-files)) )))))) t)
((not out-files)
(let ((op-done
(gethash (type-of o)
(component-operation-times c))))
(and op-done
(>= op-done
(apply #'max
(mapcar #'fwd-or-return-t in-files))))))
((not in-files) nil)
(t
(and
(every #'probe-file out-files)
(> (apply #'min (mapcar #'file-write-date out-files))
(apply #'max (mapcar #'fwd-or-return-t in-files)))))))))
;;; So you look at this code and think "why isn't it a bunch of ;;; So you look at this code and think "why isn't it a bunch of
;;; methods". And the answer is, because standard method combination ;;; methods". And the answer is, because standard method combination
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment