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