From aca68cf1232a5442292f5175df918825024f2d36 Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" <rpgoldman@sift.net> Date: Thu, 20 Jul 2017 11:40:40 -0500 Subject: [PATCH] Fix bug detecting need to reload defsystem. Previously, if one bumped a version number that was included into a system definition using :READ-FILE-FORM or :READ-FILE-LINE, ASDF would not notice the change (so it could, for example, fail to recognize that a depended-on system has had its version number bumped and now satisfies a new :VERSION requirement). This was fixed by adding ADDITIONAL-INPUT-FILES to the object model. These serve the purpose of giving a place other than INPUT-FILES for ASDF to stash input files that it "notices" on its own (e.g., when processing :READ-FILE-<FOO>). ASDF can't stash such files in INPUT-FILES, because it must leave the INPUT-FILES primary methods open for users to override. --- action.lisp | 20 +++++- asdf.asd | 3 +- component.lisp | 4 +- doc/asdf.texinfo | 21 ++++-- find-system.lisp | 5 +- interface.lisp | 5 +- parse-defsystem.lisp | 37 ++++++++-- plan.lisp | 2 +- test/test-include1.asd | 10 +++ test/test-include2.asd | 10 +++ test/test-read-depends.script | 126 ++++++++++++++++++++++++++++++++++ 11 files changed, 225 insertions(+), 18 deletions(-) create mode 100644 test/test-include1.asd create mode 100644 test/test-include2.asd create mode 100644 test/test-read-depends.script diff --git a/action.lisp b/action.lisp index d0c9e5df3..278d1f763 100644 --- a/action.lisp +++ b/action.lisp @@ -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) (:export #:action #:define-convenience-action-methods @@ -21,7 +22,8 @@ #:operation-definition-warning #:operation-definition-error ;; condition #:action-valid-p #: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) (eval-when (#-lispworks :compile-toplevel :load-toplevel :execute) ;; LispWorks issues spurious warning @@ -379,10 +381,24 @@ 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 (operation component) + (:documentation "Additional input files for the operation on this + component. These are files that are inferred, rather than + explicitly specified, and these are typically NOT files that + undergo operations directly. Instead, they are files that it is + important for ASDF to know about in order to compute operation times,etc.")) + (define-convenience-action-methods additional-input-files (operation component)) + (defmethod additional-input-files ((op operation) (comp component)) + (cdr (assoc op (%additional-input-files comp)))) + ;; Memoize input files. (defmethod input-files :around (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 operation component)))) ;; By default an action has no input-files. (defmethod input-files ((o operation) (c component)) diff --git a/asdf.asd b/asdf.asd index eca684e91..3410bfef9 100644 --- a/asdf.asd +++ b/asdf.asd @@ -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" + "find-system")) (:file "bundle" :depends-on ("lisp-action" "parse-defsystem")) (:file "concatenate-source" :depends-on ("bundle")) (:file "package-inferred-system" :depends-on ("parse-defsystem")) diff --git a/component.lisp b/component.lisp index cafeee3ec..f6890b961 100644 --- a/component.lisp +++ b/component.lisp @@ -138,7 +138,9 @@ 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) (build-operation - :initarg :build-operation :initform nil :reader component-build-operation)) + :initarg :build-operation :initform nil :reader component-build-operation) + ;; Cache for ADDITIONAL-INPUT-FILES function. + (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) diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index 78231c993..3339ab825 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -1490,6 +1490,12 @@ simple-component-name := string pathname-specifier := pathname | string | symbol +version-specifier := string + | (:read-file-form <pathname-specifier> <form-specifier>?) + | (:read-file-line <pathname-specifier> <line-specifier>?) +line-specifier := :at integer # base zero +form-specifier := :at [ integer | ( integer+ )] + method-form := (operation-name qual lambda-list @Arest{} body) qual := method qualifier? @@ -1689,12 +1695,17 @@ Instead of a string representing the version, the @code{:version} argument can be an expression that is resolved to such a string using the following trivial domain-specific language: in addition to being a literal string, it can be an expression of the form -@code{(:read-file-form <pathname-or-string> :at <access-at-specifier>)}, -which will be resolved by reading a form in the specified pathname -(read as a subpathname of the current system if relative or a unix-namestring). +@code{(:read-file-form <pathname-or-string> [:at <access-at-specifier]>)}, +or @code{(:read-file-line <pathname-or-string> [:at +<access-at-specifier]?>)}. +As the name suggests, the former will be resolved by reading a form in the specified pathname +(read as a subpathname of the current system if relative or a +unix-namestring), and the latter by reading a line. You may use a @code{uiop:access-at} specifier -with the (optional) @code{:at} keyword, -by default the specifier is @code{0}, meaning the first form is returned; +with the @code{:at} keyword, +by default the specifier is @code{0}, meaning the first form/line is +returned. +For @code{:read-file-form}, subforms can also be specified, with e.g. @code{(1 2 2)} specifying ``the third subform (index 2) of the third subform (index 2) of the second form (index 1)'' in the file (mind the off-by-one error in the English language). diff --git a/find-system.lisp b/find-system.lisp index b86f4c1bf..0a6ae6b51 100644 --- a/find-system.lisp +++ b/find-system.lisp @@ -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) (:export #:find-system #:locate-system #:load-asd #:define-op #:load-system-definition-error #:error-name #:error-pathname #:error-condition)) @@ -108,7 +109,8 @@ (asdf-message (compatfmt "~&~@<; ~@;Loading system definition~@[ for ~A~] from ~A~@:>~%") (coerce-name s) pathname) ;; dependencies will depend on what's loaded via definition-dependency-list - (unset-asdf-cache-entry `(component-depends-on ,o ,s))) + (unset-asdf-cache-entry `(component-depends-on ,o ,s)) + (unset-asdf-cache-entry `(input-files ,o ,s))) (load* pathname :external-format (encoding-external-format (detect-encoding pathname))))) (defun load-asd (pathname &key name) @@ -291,4 +293,3 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (dolist (o `(,@(when (primary-system-p component) '(define-op)) prepare-op compile-op load-op)) (setf (gethash (make-operation o) cot) 0)))))) - diff --git a/interface.lisp b/interface.lisp index 6b55b5f84..de58369c2 100644 --- a/interface.lisp +++ b/interface.lisp @@ -28,10 +28,11 @@ #:non-propagating-operation #:build-op #:make #:load-op #:prepare-op #:compile-op - #:prepare-source-op #:load-source-op #:test-op + #:prepare-source-op #:load-source-op #:test-op #:define-op #:feature #:version #:version-satisfies #:upgrade-asdf #:implementation-identifier #:implementation-type #:hostname - #:input-files #:output-files #:output-file #:perform #:perform-with-restarts + #:input-files #:additional-input-files + #:output-files #:output-file #:perform #:perform-with-restarts #:operation-done-p #:explain #:action-description #:component-sideway-dependencies #:needed-in-image-p #:component-load-dependencies #:run-shell-command ; deprecated, do not use diff --git a/parse-defsystem.lisp b/parse-defsystem.lisp index 7845871fa..8894bd042 100644 --- a/parse-defsystem.lisp +++ b/parse-defsystem.lisp @@ -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) (:export #:defsystem #:register-system-definition #:class-for-type #:*default-component-class* @@ -102,6 +106,27 @@ 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 :with retval + :for par = parent :then (component-parent par) + :while par + :do (setf retval par) + :finally (return retval)) + component)) + (comp (if (typep record-on 'component) + record-on + ;; at this point there will be no parent for RECORD-ON + (find-component record-on nil))) + (op (make-operation 'define-op)) + (cell (or (assoc op (%additional-input-files comp)) + (let ((new-cell (list op))) + (push new-cell (%additional-input-files comp)) + new-cell)))) + (pushnew pathname (cdr cell) :test 'pathname-equal) + (values))) + ;; 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 +147,16 @@ Please only define ~S and secondary systems with a name starting with ~S (e.g. ~ (case (first form) ((:read-file-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)))) ((:read-file-line) (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)))) (otherwise (invalid)))) (t diff --git a/plan.lisp b/plan.lisp index d0690ebb5..61b3abf0b 100644 --- a/plan.lisp +++ b/plan.lisp @@ -64,7 +64,7 @@ (stamp :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.") (level :type fixnum :initarg :level :initform 0 :reader status-level :documentation "the highest (operate-level) at which the action was needed") diff --git a/test/test-include1.asd b/test/test-include1.asd new file mode 100644 index 000000000..6d09426a1 --- /dev/null +++ b/test/test-include1.asd @@ -0,0 +1,10 @@ +;;;--------------------------------------------------------------------------- +;;; Sample system to test inclusion of lines from other files and +;;; correct reasoning about system modifications. +;;;--------------------------------------------------------------------------- + +(defsystem test-include + :version (:read-file-form "../build/random-version.lisp-expr") + :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")) + (load-op (load-op "file1")))) + (:file "file1"))) \ No newline at end of file diff --git a/test/test-include2.asd b/test/test-include2.asd new file mode 100644 index 000000000..0cf2c0879 --- /dev/null +++ b/test/test-include2.asd @@ -0,0 +1,10 @@ +;;;--------------------------------------------------------------------------- +;;; Sample system to test inclusion of lines from other files and +;;; correct reasoning about system modifications. +;;;--------------------------------------------------------------------------- + +(defsystem test-include + :version (:read-file-form "../build/random-version2.lisp-expr") + :components ((:file "file2" :in-order-to ((compile-op (load-op "file1")) + (load-op (load-op "file1")))) + (:file "file1"))) \ No newline at end of file diff --git a/test/test-read-depends.script b/test/test-read-depends.script new file mode 100644 index 000000000..a69e5b0c4 --- /dev/null +++ b/test/test-read-depends.script @@ -0,0 +1,126 @@ +;;; -*- Lisp -*- +;;; --------------------------------------------------------------------------- +;;; Test to make sure that an update to included files causes a reload +;;; of the system definition. +;;; --------------------------------------------------------------------------- + +(in-package :asdf-test) + +;; I don't know what this does or when it's necessary +;; (setf asdf::*asdf-session* (make-instance asdf::*asdf-session-class*)) +(defparameter *tmp-directory* (subpathname *asdf-directory* "build/")) +;;(defparameter *test-directory* (subpathname *asdf-directory* "test/")) +(push *test-directory* *central-registry*) +(defun under-tmp-directory (designator &optional (defaults *tmp-directory*)) + (namestring (subpathname defaults designator))) +(defun under-test-directory (designator &optional (defaults *test-directory*)) + (namestring (subpathname defaults designator))) + +(defun copy-file-the-hard-way (source dest) + (with-open-file (sourcestr source) + (with-open-file (deststr dest :direction :output :if-exists :supersede) + (loop :for line = (read-line sourcestr nil nil) + :while line + :do (format deststr "~a~%" line)))) + (values)) + +(defparameter *version-file* + (under-tmp-directory "random-version.lisp-expr")) + +;; (trace asdf/component:additional-input-files asdf/parse-defsystem::record-additional-system-input-file) + +;;; write an initial version file +(unwind-protect + (progn + (with-open-file (str *version-file* :direction :output + :if-exists :supersede) + (format str "\"1.0\"~%")) + (copy-file-the-hard-way (under-test-directory "test-include1.asd") + (under-test-directory "test-include.asd")) + (DBG "Set up test-include system definition:" + (probe-file (under-test-directory "test-include.asd"))) + (asdf:load-system "test-include") + (let ((system (asdf:find-system "test-include"))) + (DBG "On initial load, the system version is" (component-version system)) + (DBG "After initial load the input files for the define op are:" + (input-files (make-operation 'define-op) system)) + + ;; read the initial version information correctly... + (assert-equal (asdf:component-version system) "1.0")) + (DBG "*******Initial load successful*******") + (sleep 2) + (DBG "*******Reloading*******") + ;;(trace asdf/plan::action-up-to-date-p) + ;; (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::get-file-stamp :inside asdf/plan::compute-action-stamp)) + +;;; bump the version + (with-open-file (str *version-file* :direction :output + :if-exists :supersede) + (format str "\"2.0\"~%")) + (asdf:load-system "test-include") + (let ((system (asdf:find-system "test-include"))) + (DBG "After reload, system version is" (asdf:component-version system)) + ;; read the initial version information correctly... + (assert-equal (asdf:component-version system) "2.0"))) + (sleep 2) + (DBG "*******Using new input file*******") + (let ((version-file + (under-tmp-directory "random-version2.lisp-expr"))) + (unwind-protect + ;; swap system definitions with different read file versions + (progn + (copy-file-the-hard-way + (under-test-directory "test-include2.asd") + (under-test-directory "test-include.asd")) + (with-open-file (str version-file :direction :output + :if-exists :supersede) + (format str "\"3.0\"~%")) + (DBG "Test-include ASDF file write date" + (uiop:safe-file-write-date (under-test-directory "test-include.asd"))) + (DBG "version file write date" + (uiop:safe-file-write-date (under-tmp-directory "random-version2.lisp-expr"))) + + ;;; the following establishes that it is NOT the fault of + ;;; DEFINITION-DEPENDENCIES-UP-TO-DATE-P [2017/07/12:rpg] + #+allegro + (trace (asdf/find-system::definition-dependencies-up-to-date-p + :inside asdf:find-system) + (asdf/find-system::get-file-stamp + :inside find-system) + (asdf/find-system::stamp<= + :inside find-system)) + ;; AFAICT, the :WHEREIN in SBCL TRACE does not work + ;; properly. In my copious free time, I should see if I + ;; can find a minimal test case. [2017/07/12:rpg] + #+sbcl + (trace asdf/find-system::definition-dependencies-up-to-date-p + ;; :wherein asdf:find-system + ) + + (DBG "operation time stamp for define-op before reload" + (asdf/action:component-operation-time + (asdf:make-operation 'define-op) + (asdf:find-system "test-include"))) + ;; this is NOT why this is broken on ACL... + #+ignore + (DBG "ASDF thinks the operation is done?" + (asdf:operation-done-p (make-operation 'define-op) + (find-system "test-include"))) + ;; (trace asdf/action:compute-action-stamp asdf:make-plan) + ;; (trace asdf/plan::perform-plan asdf/plan::action-already-done-p) + (asdf:load-system "test-include") + (let ((system (find-system "test-include"))) + (assert-equal (asdf:component-version system) "3.0") + (assert-pathnames-equal (asdf:input-files + (asdf:make-operation 'asdf:define-op) + system) + (mapcar 'parse-namestring + (list (under-test-directory "test-include.asd") + (under-tmp-directory "random-version2.lisp-expr")))))) + (uiop:delete-file-if-exists version-file))) + (uiop:delete-file-if-exists (under-test-directory "test-include.asd")) + (uiop:delete-file-if-exists *version-file*)) -- GitLab