From ceca525bea4e948ed3a0636709d5a6110951c7da Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <fare@tunes.org> Date: Fri, 12 Feb 2010 15:30:54 -0500 Subject: [PATCH] Refactored and documented operation-done-p. Started as an attempt to "enhance" it, until thinking about why I was breaking tests told me I couldn't. --- asdf.lisp | 56 ++++++++++++++++++++---------- test/test-static-and-serial.script | 3 +- 2 files changed, 39 insertions(+), 20 deletions(-) diff --git a/asdf.lisp b/asdf.lisp index 13aa55cb..07788bef 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -1108,25 +1108,43 @@ class NAME, not an operation." (defmethod operation-done-p ((o operation) (c component)) (let ((out-files (output-files o c)) - (in-files (input-files o c))) - (cond ((and (not in-files) (not out-files)) - ;; arbitrary decision: an operation that uses nothing to - ;; produce nothing probably isn't doing much - t) - ((not out-files) - (let ((op-done - (gethash (type-of o) - (component-operation-times c)))) - (and op-done - (>= op-done - (apply #'max - (mapcar #'safe-file-write-date in-files)))))) - ((not in-files) nil) - (t - (and - (every #'probe-file out-files) - (> (apply #'min (mapcar #'safe-file-write-date out-files)) - (apply #'max (mapcar #'safe-file-write-date in-files)))))))) + (in-files (input-files o c)) + (op-time (gethash (type-of o) (component-operation-times c)))) + (flet ((earliest-out () + (reduce #'min (mapcar #'safe-file-write-date out-files))) + (latest-in () + (reduce #'max (mapcar #'safe-file-write-date in-files)))) + (cond + ((and (not in-files) (not out-files)) + ;; arbitrary decision: an operation that uses nothing to + ;; produce nothing probably isn't doing much. + ;; e.g. operations on systems, modules that have no immediate action, + ;; but are only meaningful through traversed dependencies + t) + ((not out-files) + ;; an operation without output-files is probably meant + ;; for its side-effects in the current image, + ;; assumed to be idem-potent, + ;; e.g. LOAD-OP or LOAD-SOURCE-OP of some CL-SOURCE-FILE. + (and op-time + (>= op-time (latest-in)))) + ((not in-files) + ;; an operation without output-files and no input-files + ;; is probably meant for its side-effects on the file-system, + ;; assumed to have to be done everytime. + ;; (I don't think there is any such case in ASDF unless extended) + nil) + (t + ;; an operation with both input and output files is assumed + ;; as computing the latter from the former, + ;; assumed to have been done if the latter are all older + ;; than the former. + ;; e.g. COMPILE-OP of some CL-SOURCE-FILE. + (and + (every #'probe-file in-files) + (every #'probe-file out-files) + (and (> (earliest-out) (latest-in))))))))) + ;;; So you look at this code and think "why isn't it a bunch of ;;; methods". And the answer is, because standard method combination diff --git a/test/test-static-and-serial.script b/test/test-static-and-serial.script index 6e20a0cb..4915cf5e 100644 --- a/test/test-static-and-serial.script +++ b/test/test-static-and-serial.script @@ -4,8 +4,9 @@ (quit-on-error (setf asdf:*central-registry* '(*default-pathname-defaults*)) + ;;(trace asdf:operation-done-p asdf::safe-file-write-date) (asdf:operate 'asdf:load-op 'static-and-serial) - (let* ((file1 (asdf:compile-file-pathname* (truename "file1.lisp"))) + (let* ((file1 (asdf:compile-file-pathname* "file1")) (file1-date (file-write-date file1)) (asdf::*defined-systems* (make-hash-table :test 'equal))) ;; cheat -- GitLab