Commit 18b8cfe3 authored by Robert Goldman's avatar Robert Goldman

Fix bug detecting change in read files.

Files read in by READ-FILE-LINE or READ-FILE-FORM were not being
tracked.  With this change, they are noticed and added to
ADDITIONAL-INPUT-FILES for a component and operation.

Adding this tracking led to introduction of a new dependency in

Also, added a comparison between the operation-time and the latest
update time for the input files of a component and operation.
Previously, even if the input files were newer than the last operation
time, if there were no output files, ASDF would incorrectly think the
operation was up-to-date.
parent a59bdc4d
......@@ -6,6 +6,7 @@
(:recycle :asdf/action :asdf/plan :asdf)
(:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session :asdf/component :asdf/operation)
(:import-from :asdf/operation #:check-operation-constructor)
(:import-from :asdf/component #:%additional-input-files)
#-clisp (:unintern #:required-components #:traverse-action #:traverse-sub-actions)
#:action #:define-convenience-action-methods
......@@ -21,7 +22,8 @@
#:operation-definition-warning #:operation-definition-error ;; condition
#:circular-dependency #:circular-dependency-actions
#:call-while-visiting-action #:while-visiting-action))
#:call-while-visiting-action #:while-visiting-action
(in-package :asdf/action)
(eval-when (#-lispworks :compile-toplevel :load-toplevel :execute) ;; LispWorks issues spurious warning
......@@ -379,10 +381,23 @@ They may rely on the order of the files to discriminate between inputs.
(assert (length=n-p files 1))
(first files)))
(defgeneric additional-input-files (component op)
(:documentation "Additional input files for the operation on this
component. These are files that are inferred, rather than
explicitly specified.")
(:method (comp (op symbol))
(additional-input-files comp (make-operation op)))
(:method ((comp component) (op operation))
(cdr (assoc op (%additional-input-files comp)))))
;; Memoize input files.
(defmethod input-files :around (operation component)
(do-asdf-cache `(input-files ,operation ,component)
;; get the additional input files, if any
(append (call-next-method)
;; must come after the first, for other code that
;; assumes the first will be the "key" file
(additional-input-files component operation))))
;; By default an action has no input-files.
(defmethod input-files ((o operation) (c component))
......@@ -62,7 +62,8 @@
(:file "plan" :depends-on ("lisp-action" "find-component" "forcing"))
(:file "operate" :depends-on ("plan"))
(:file "find-system" :depends-on ("system-registry" "operate"))
(:file "parse-defsystem" :depends-on ("system-registry" "lisp-action" "operate"))
(:file "parse-defsystem" :depends-on ("system-registry" "lisp-action" "operate"
"operation" "find-system"))
(:file "bundle" :depends-on ("lisp-action" "parse-defsystem"))
(:file "concatenate-source" :depends-on ("bundle"))
(:file "package-inferred-system" :depends-on ("parse-defsystem"))
......@@ -28,6 +28,7 @@
#:module-components ;; backward-compatibility. DO NOT USE.
;; conditions
......@@ -138,7 +139,11 @@ or NIL for top-level components (a.k.a. systems)"))
;; For backward-compatibility, this slot is part of component rather than of child-component. ASDF4: stop it.
(parent :initarg :parent :initform nil :reader component-parent)
:initarg :build-operation :initform nil :reader component-build-operation))
:initarg :build-operation :initform nil :reader component-build-operation)
;; input files that are inferred instead of being specified.
;; Currently this is used only to track files from READ-FILE-FORM
(additional-input-files :accessor %additional-input-files :initform nil))
(:documentation "Base class for all components of a build"))
(defgeneric find-component (base path &key registered)
......@@ -6,6 +6,7 @@
(:use :uiop/common-lisp :uiop :asdf/upgrade
:asdf/session :asdf/component :asdf/system :asdf/operation :asdf/action :asdf/lisp-action
:asdf/find-component :asdf/system-registry :asdf/plan :asdf/operate)
(:import-from #:asdf/component #:%additional-input-files)
#:find-system #:locate-system #:load-asd #:define-op
#:load-system-definition-error #:error-name #:error-pathname #:error-condition))
......@@ -292,3 +293,17 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
prepare-op compile-op load-op))
(setf (gethash (make-operation o) cot) 0))))))
;;; additional methods for additional-input-files that are responsible for looking up systems.
(with-upgradability ()
(defmethod additional-input-files ((comp symbol) op)
(additional-input-files (find-system comp) op))
(defmethod additional-input-files ((comp string) op)
(additional-input-files (find-system comp) op))
(defmethod %additional-input-files ((comp symbol))
(%additional-input-files (find-system comp)))
(defmethod %additional-input-files ((comp string))
(%additional-input-files (find-system comp)))
(defmethod (setf %additional-input-files) (val (comp symbol))
(setf (%additional-input-files (find-system comp)) val))
(defmethod (setf %additional-input-files) (val (comp string))
(setf (%additional-input-files (find-system comp)) val)))
......@@ -8,6 +8,10 @@
:asdf/session :asdf/component :asdf/system :asdf/system-registry
:asdf/find-component :asdf/action :asdf/lisp-action :asdf/operate)
(:import-from :asdf/system #:depends-on #:weakly-depends-on)
;; these needed for record-additional-system-input-file
(:import-from :asdf/operation #:make-operation)
(:import-from :asdf/component #:%additional-input-files)
(:import-from :asdf/find-system #:define-op)
#:defsystem #:register-system-definition
#:class-for-type #:*default-component-class*
......@@ -102,6 +106,23 @@ Please only define ~S and secondary systems with a name starting with ~S (e.g. ~
(sysdef-error-component ":components must be NIL or a list of components."
type name components)))
(defun record-additional-system-input-file (pathname component parent)
(let* ((record-on (if parent
(loop :for par = parent :then (component-parent par)
:with retval
:while par
:do (setf retval par)
:finally (return retval))
(op (make-operation 'define-op))
(cell (or (assoc op (%additional-input-files record-on))
(let ((new-cell (list op)))
(push new-cell (%additional-input-files record-on))
(pushnew pathname (cdr cell) :test 'pathname-equal)
;; Given a form used as :version specification, in the context of a system definition
;; in a file at PATHNAME, for given COMPONENT with given PARENT, normalize the form
;; to an acceptable ASDF-format version.
......@@ -122,12 +143,16 @@ Please only define ~S and secondary systems with a name starting with ~S (e.g. ~
(case (first form)
(destructuring-bind (subpath &key (at 0)) (rest form)
(safe-read-file-form (subpathname pathname subpath)
:at at :package :asdf-user)))
(let ((path (subpathname pathname subpath)))
(record-additional-system-input-file path component parent)
(safe-read-file-form path
:at at :package :asdf-user))))
(destructuring-bind (subpath &key (at 0)) (rest form)
(safe-read-file-line (subpathname pathname subpath)
:at at)))
(let ((path (subpathname pathname subpath)))
(record-additional-system-input-file path component parent)
(safe-read-file-line (subpathname pathname subpath)
:at at))))
......@@ -64,7 +64,7 @@
:type (or integer boolean) :initarg :stamp :reader status-stamp
:documentation "STAMP associated with the ACTION if it has been completed already in some
previous sessino or image, T if it was done and builtin the image, or NIL if it needs to be done.")
previous session or image, T if it was done and builtin the image, or NIL if it needs to be done.")
:type fixnum :initarg :level :initform 0 :reader status-level
:documentation "the highest (operate-level) at which the action was needed")
......@@ -305,7 +305,8 @@ initialized with SEED."
;; Has any input changed since we last generated the files?
;; Note that we use stamp<= instead of stamp< 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 (and (stamp<= latest-in earliest-out)
(stamp<= latest-in (component-operation-time o c))))
;; 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:
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