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