Commit aca68cf1 by Robert Goldman Committed by Francois-Rene Rideau

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.
parent b0f468c0
......@@ -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))
......
......@@ -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"))
......
......@@ -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)
......
......@@ -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).
......
......@@ -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))))))
......@@ -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
......
......@@ -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
......
......@@ -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")
......
;;;---------------------------------------------------------------------------
;;; 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
;;;---------------------------------------------------------------------------
;;; 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
;;; -*- 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*))
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