diff --git a/contrib/debug-plan.lisp b/contrib/debug-plan.lisp index f488b289409090bc6f65236a37c391c7c9c4987d..a60687de3f21902481a648dee7eaa89c45dcdddb 100644 --- a/contrib/debug-plan.lisp +++ b/contrib/debug-plan.lisp @@ -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 (timestamps-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 (timestamps-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 timestamp< 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 (timestamp<= 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 (timestamps-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)) diff --git a/find-system.lisp b/find-system.lisp index 69b84dbe2b8c396e1783547dac6d4bd7eed3961f..c39f1f026ed6cf29c8afc747fa15665a998c28f2 100644 --- a/find-system.lisp +++ b/find-system.lisp @@ -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 (timestamp<= 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) + (timestamp<= 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. diff --git a/plan.lisp b/plan.lisp index 3f9bf2b40cab14cf2b67fc2b38f1e9bd8e3fdeec..83f79991502944c81563bdae0619cd38123f244c 100644 --- a/plan.lisp +++ b/plan.lisp @@ -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-timestamp (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 (timestamps-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 (timestamps-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 timestamp< 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 (timestamp<= 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 (timestamps-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)) diff --git a/test/script-support.lisp b/test/script-support.lisp index 936055d7db815d585b11770d42d828887c9efb80..e2b13096ce0e1125254f3709fdb8ea92742c54b3 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -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) diff --git a/test/test-read-depends.script b/test/test-read-depends.script index a69e5b0c4fcdb7571a87d54c1dfa8961f7faeafc..3a230d90df1e93d766ee6eb0fe1f4b83ce340518 100644 --- a/test/test-read-depends.script +++ b/test/test-read-depends.script @@ -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::timestamp<= :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::timestamp<= :inside find-system)) ;; AFAICT, the :WHEREIN in SBCL TRACE does not work ;; properly. In my copious free time, I should see if I diff --git a/uiop/utility.lisp b/uiop/utility.lisp index 0b94273a2933637bcb3f14cb7c16e4362dfe100c..3f4dd24343ea506f9e650ca7d2358f6af03a8bf7 100644 --- a/uiop/utility.lisp +++ b/uiop/utility.lisp @@ -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<= ;; timestamps + #:earlier-timestamp #:timestamps-earliest #:earliest-timestamp + #:later-timestamp #:timestamps-latest #:latest-timestamp #:latest-timestamp-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 +;;; timestamps: a REAL or a boolean where T=-infinity, NIL=+infinity (eval-when (#-lispworks :compile-toplevel :load-toplevel :execute) - (deftype stamp () '(or real boolean))) + (deftype timestamp () '(or real boolean))) (with-upgradability () - (defun stamp< (x y) + (defun timestamp< (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 (timestamp< x y))) + (defun timestamp*< (&rest list) (timestamps< list)) + (defun timestamp<= (x y) (not (timestamp< y x))) + (defun earlier-timestamp (x y) (if (timestamp< x y) x y)) + (defun timestamps-earliest (list) (reduce 'earlier-timestamp list :initial-value nil)) + (defun earliest-timestamp (&rest list) (timestamps-earliest list)) + (defun later-timestamp (x y) (if (timestamp< x y) y x)) + (defun timestamps-latest (list) (reduce 'later-timestamp list :initial-value t)) + (defun latest-timestamp (&rest list) (timestamps-latest list)) + (define-modify-macro latest-timestamp-f (&rest timestamps) latest-timestamp)) ;;; Function designators