Commit 3d0d07c3 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Properly treat DEFINE-OP dependencies

parent a3b85c8b
...@@ -17,7 +17,7 @@ ...@@ -17,7 +17,7 @@
#:action-status #:action-stamp #:action-done-p #:action-status #:action-stamp #:action-done-p
#:action-operation #:action-component #:make-action #:action-operation #:action-component #:make-action
#:component-operation-time #:mark-operation-done #:compute-action-stamp #:component-operation-time #:mark-operation-done #:compute-action-stamp
#:perform #:perform-with-restarts #:retry #:accept #:perform #:perform-with-restarts #:retry #:accept #:*action*
#:action-path #:find-action #:stamp #:done-p #:action-path #:find-action #:stamp #:done-p
#:operation-definition-warning #:operation-definition-error ;; condition #:operation-definition-warning #:operation-definition-error ;; condition
#:action-valid-p #:action-valid-p
...@@ -426,6 +426,11 @@ in some previous image, or T if it needs to be done.") ...@@ -426,6 +426,11 @@ in some previous image, or T if it needs to be done.")
(:documentation "PERFORM an action, consuming its input-files and building its output-files")) (:documentation "PERFORM an action, consuming its input-files and building its output-files"))
(define-convenience-action-methods perform (operation component)) (define-convenience-action-methods perform (operation component))
(defvar *action* nil
"Action being performed")
(defmethod perform :around ((o operation) (c component))
(let ((*action* (cons o c)))
(call-next-method)))
(defmethod perform :before ((o operation) (c component)) (defmethod perform :before ((o operation) (c component))
(ensure-all-directories-exist (output-files o c))) (ensure-all-directories-exist (output-files o c)))
(defmethod perform :after ((o operation) (c component)) (defmethod perform :after ((o operation) (c component))
......
...@@ -51,24 +51,26 @@ ...@@ -51,24 +51,26 @@
(and (typep operation 'load-op) (and (typep operation 'load-op)
(typep component 'system) (typep component 'system)
(equal "asdf" (coerce-name component)))) (equal "asdf" (coerce-name component))))
(let* ((action (first (visiting-action-list *asdf-session*))) (when *action*
(parent-operation (car action)) (let ((parent-operation (car *action*))
(parent-component (cdr action))) (parent-component (cdr *action*)))
(when (and parent-operation parent-component)
(unless (and (typep parent-operation 'define-op) (typep parent-component 'system)) (unless (and (typep parent-operation 'define-op) (typep parent-component 'system))
(error "Invalid recursive use of (OPERATE ~S ~S) while visiting ~S ~ (error "Invalid recursive use of (OPERATE ~S ~S) while visiting ~S ~
- please use proper dependencies instead." - please use proper dependencies instead."
operation component action)) operation component *action*))
(push action (definition-dependencies parent-component)))))) (let ((action (cons operation component)))
(unless (gethash action (definition-dependency-set parent-component))
(push (cons operation component) (definition-dependency-list parent-component))
(setf (gethash action (definition-dependency-set parent-component)) t)))))))
(defmethod component-depends-on ((o define-op) (s system)) (defmethod component-depends-on ((o define-op) (s system))
`(;;NB: 1- ,@(system-defsystem-depends-on s)) ; Should be already included in the below. `(;;NB: 1- ,@(system-defsystem-depends-on s)) ; Should be already included in the below.
;; 2- We don't call-next-method to avoid other methods ;; 2- We don't call-next-method to avoid other methods
,@(loop* :for (o . c) :in (definition-dependencies s) :collect (list o c)))) ,@(loop* :for (o . c) :in (definition-dependency-list s) :collect (list o c))))
(defmethod component-depends-on ((o operation) (s system)) (defmethod component-depends-on ((o operation) (s system))
`(,@(when (and (not (typep o 'define-op)) `(,@(when (and (not (typep o 'define-op))
(or (system-source-file s) (definition-dependencies s))) (or (system-source-file s) (definition-dependency-list s)))
`((define-op ,(primary-system-name s)))) `((define-op ,(primary-system-name s))))
,@(call-next-method))) ,@(call-next-method)))
...@@ -104,7 +106,7 @@ ...@@ -104,7 +106,7 @@
:name (coerce-name s) :pathname pathname :condition condition)))) :name (coerce-name s) :pathname pathname :condition condition))))
(asdf-message (compatfmt "~&~@<; ~@;Loading system definition~@[ for ~A~] from ~A~@:>~%") (asdf-message (compatfmt "~&~@<; ~@;Loading system definition~@[ for ~A~] from ~A~@:>~%")
(coerce-name s) pathname) (coerce-name s) pathname)
;; dependencies will depend on what's loaded via definition-dependencies ;; 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))
(load* pathname :external-format (encoding-external-format (detect-encoding pathname)))))) (load* pathname :external-format (encoding-external-format (detect-encoding pathname))))))
......
...@@ -9,7 +9,7 @@ ...@@ -9,7 +9,7 @@
#:system-source-file #:system-source-directory #:system-relative-pathname #:system-source-file #:system-source-directory #:system-relative-pathname
#:system-description #:system-long-description #:system-description #:system-long-description
#:system-author #:system-maintainer #:system-licence #:system-license #:system-author #:system-maintainer #:system-licence #:system-license
#:definition-dependencies #:system-defsystem-depends-on #:definition-dependency-list #:definition-dependency-set #:system-defsystem-depends-on
#:system-depends-on #:system-weakly-depends-on #:system-depends-on #:system-weakly-depends-on
#:component-build-pathname #:build-pathname #:component-build-pathname #:build-pathname
#:component-entry-point #:entry-point #:component-entry-point #:entry-point
...@@ -89,8 +89,11 @@ a SYSTEM is redefined and its class is modified.")) ...@@ -89,8 +89,11 @@ a SYSTEM is redefined and its class is modified."))
;; This slot contains the *declared* defsystem-depends-on dependencies ;; This slot contains the *declared* defsystem-depends-on dependencies
(defsystem-depends-on :reader system-defsystem-depends-on :initarg :defsystem-depends-on (defsystem-depends-on :reader system-defsystem-depends-on :initarg :defsystem-depends-on
:initform nil) :initform nil)
;; This slot contains the *inferred* dependencies of define-op ;; These slots contains the *inferred* dependencies of define-op, as list and as set
(definition-dependencies :initform nil :accessor definition-dependencies) (definition-dependency-list
:initform nil :accessor definition-dependency-list)
(definition-dependency-set
:initform (list-to-hash-set nil) :accessor definition-dependency-set)
;; these two are specially set in parse-component-form, so have no :INITARGs. ;; these two are specially set in parse-component-form, so have no :INITARGs.
(depends-on :reader system-depends-on :initform nil) (depends-on :reader system-depends-on :initform nil)
(weakly-depends-on :reader system-weakly-depends-on :initform nil)) (weakly-depends-on :reader system-weakly-depends-on :initform nil))
......
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