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
asdf.asd.

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 @@ ...@@ -6,6 +6,7 @@
(:recycle :asdf/action :asdf/plan :asdf) (:recycle :asdf/action :asdf/plan :asdf)
(:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session :asdf/component :asdf/operation) (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session :asdf/component :asdf/operation)
(:import-from :asdf/operation #:check-operation-constructor) (:import-from :asdf/operation #:check-operation-constructor)
(:import-from :asdf/component #:%additional-input-files)
#-clisp (:unintern #:required-components #:traverse-action #:traverse-sub-actions) #-clisp (:unintern #:required-components #:traverse-action #:traverse-sub-actions)
(:export (:export
#:action #:define-convenience-action-methods #:action #:define-convenience-action-methods
...@@ -21,7 +22,8 @@ ...@@ -21,7 +22,8 @@
#:operation-definition-warning #:operation-definition-error ;; condition #:operation-definition-warning #:operation-definition-error ;; condition
#:action-valid-p #:action-valid-p
#:circular-dependency #:circular-dependency-actions #:circular-dependency #:circular-dependency-actions
#:call-while-visiting-action #:while-visiting-action)) #:call-while-visiting-action #:while-visiting-action
#:additional-input-files))
(in-package :asdf/action) (in-package :asdf/action)
(eval-when (#-lispworks :compile-toplevel :load-toplevel :execute) ;; LispWorks issues spurious warning (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. ...@@ -379,10 +381,23 @@ They may rely on the order of the files to discriminate between inputs.
(assert (length=n-p files 1)) (assert (length=n-p files 1))
(first files))) (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. ;; Memoize input files.
(defmethod input-files :around (operation component) (defmethod input-files :around (operation component)
(do-asdf-cache `(input-files ,operation ,component) (do-asdf-cache `(input-files ,operation ,component)
(call-next-method))) ;; 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. ;; By default an action has no input-files.
(defmethod input-files ((o operation) (c component)) (defmethod input-files ((o operation) (c component))
......
...@@ -62,7 +62,8 @@ ...@@ -62,7 +62,8 @@
(:file "plan" :depends-on ("lisp-action" "find-component" "forcing")) (:file "plan" :depends-on ("lisp-action" "find-component" "forcing"))
(:file "operate" :depends-on ("plan")) (:file "operate" :depends-on ("plan"))
(:file "find-system" :depends-on ("system-registry" "operate")) (: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 "bundle" :depends-on ("lisp-action" "parse-defsystem"))
(:file "concatenate-source" :depends-on ("bundle")) (:file "concatenate-source" :depends-on ("bundle"))
(:file "package-inferred-system" :depends-on ("parse-defsystem")) (:file "package-inferred-system" :depends-on ("parse-defsystem"))
......
...@@ -28,6 +28,7 @@ ...@@ -28,6 +28,7 @@
#:module-default-component-class #:module-default-component-class
#:module-components ;; backward-compatibility. DO NOT USE. #:module-components ;; backward-compatibility. DO NOT USE.
#:sub-components #:sub-components
#:additional-input-files
;; conditions ;; conditions
#:duplicate-names #:duplicate-names
...@@ -138,7 +139,11 @@ or NIL for top-level components (a.k.a. systems)")) ...@@ -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. ;; 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) (parent :initarg :parent :initform nil :reader component-parent)
(build-operation (build-operation
: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
;; and READ-FILE-LINE.
(additional-input-files :accessor %additional-input-files :initform nil))
(:documentation "Base class for all components of a build")) (:documentation "Base class for all components of a build"))
(defgeneric find-component (base path &key registered) (defgeneric find-component (base path &key registered)
......
...@@ -6,6 +6,7 @@ ...@@ -6,6 +6,7 @@
(:use :uiop/common-lisp :uiop :asdf/upgrade (:use :uiop/common-lisp :uiop :asdf/upgrade
:asdf/session :asdf/component :asdf/system :asdf/operation :asdf/action :asdf/lisp-action :asdf/session :asdf/component :asdf/system :asdf/operation :asdf/action :asdf/lisp-action
:asdf/find-component :asdf/system-registry :asdf/plan :asdf/operate) :asdf/find-component :asdf/system-registry :asdf/plan :asdf/operate)
(:import-from #:asdf/component #:%additional-input-files)
(:export (:export
#:find-system #:locate-system #:load-asd #:define-op #:find-system #:locate-system #:load-asd #:define-op
#:load-system-definition-error #:error-name #:error-pathname #:error-condition)) #: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. ...@@ -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)) prepare-op compile-op load-op))
(setf (gethash (make-operation o) cot) 0)))))) (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 @@ ...@@ -8,6 +8,10 @@
:asdf/session :asdf/component :asdf/system :asdf/system-registry :asdf/session :asdf/component :asdf/system :asdf/system-registry
:asdf/find-component :asdf/action :asdf/lisp-action :asdf/operate) :asdf/find-component :asdf/action :asdf/lisp-action :asdf/operate)
(:import-from :asdf/system #:depends-on #:weakly-depends-on) (: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)
(:export (:export
#:defsystem #:register-system-definition #:defsystem #:register-system-definition
#:class-for-type #:*default-component-class* #: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. ~ ...@@ -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." (sysdef-error-component ":components must be NIL or a list of components."
type name 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))
component))
(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))
new-cell))))
(pushnew pathname (cdr cell) :test 'pathname-equal)
(values)))
;; Given a form used as :version specification, in the context of a system definition ;; 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 ;; in a file at PATHNAME, for given COMPONENT with given PARENT, normalize the form
;; to an acceptable ASDF-format version. ;; 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. ~ ...@@ -122,12 +143,16 @@ Please only define ~S and secondary systems with a name starting with ~S (e.g. ~
(case (first form) (case (first form)
((:read-file-form) ((:read-file-form)
(destructuring-bind (subpath &key (at 0)) (rest form) (destructuring-bind (subpath &key (at 0)) (rest form)
(safe-read-file-form (subpathname pathname subpath) (let ((path (subpathname pathname subpath)))
:at at :package :asdf-user))) (record-additional-system-input-file path component parent)
(safe-read-file-form path
:at at :package :asdf-user))))
((:read-file-line) ((:read-file-line)
(destructuring-bind (subpath &key (at 0)) (rest form) (destructuring-bind (subpath &key (at 0)) (rest form)
(safe-read-file-line (subpathname pathname subpath) (let ((path (subpathname pathname subpath)))
:at at))) (record-additional-system-input-file path component parent)
(safe-read-file-line (subpathname pathname subpath)
:at at))))
(otherwise (otherwise
(invalid)))) (invalid))))
(t (t
......
...@@ -64,7 +64,7 @@ ...@@ -64,7 +64,7 @@
(stamp (stamp
:type (or integer boolean) :initarg :stamp :reader status-stamp :type (or integer boolean) :initarg :stamp :reader status-stamp
:documentation "STAMP associated with the ACTION if it has been completed already in some :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.")
(level (level
:type fixnum :initarg :level :initform 0 :reader status-level :type fixnum :initarg :level :initform 0 :reader status-level
:documentation "the highest (operate-level) at which the action was needed") :documentation "the highest (operate-level) at which the action was needed")
...@@ -305,7 +305,8 @@ initialized with SEED." ...@@ -305,7 +305,8 @@ initialized with SEED."
;; Has any input changed since we last generated the files? ;; 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 stamp<= instead of stamp< to play nice with generated files.
;; Any race condition is intrinsic to the limited timestamp resolution. ;; 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 ;; 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 (stamps-latest (cons latest-in out-stamps))))
;; Warn if some files are missing: ;; 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