Skip to content
Snippets Groups Projects
Commit eb2da723 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Implement the discussed non-monotonic inheritance of propagation traits.

For backward compatibility with ASDF 2, an operation that doesn't explicitly
inherit from one of the propagation classes or non-propagating-operation
will be downward- and sideway- propagating, with a warning at instantiation.
Inheriting from non-propagating and a propagating class at the same time
yields an error, not a warning.
Update packages and tests.
parent cf56bc2d
No related branches found
No related tags found
No related merge requests found
...@@ -18,7 +18,7 @@ ...@@ -18,7 +18,7 @@
#:traverse-actions #:traverse-sub-actions #:required-components ;; in plan #:traverse-actions #:traverse-sub-actions #:required-components ;; in plan
#:action-path #:find-action #:stamp #:done-p #:action-path #:find-action #:stamp #:done-p
;; condition ;; condition
#:operation-definition-error #:operation-definition-warning #:operation-definition-error
)) ))
(in-package :asdf/action) (in-package :asdf/action)
...@@ -127,10 +127,7 @@ You can put together sentences using this phrase.")) ...@@ -127,10 +127,7 @@ You can put together sentences using this phrase."))
(defmethod component-depends-on :around ((o operation) (c component)) (defmethod component-depends-on :around ((o operation) (c component))
(do-asdf-cache `(component-depends-on ,o ,c) (do-asdf-cache `(component-depends-on ,o ,c)
(call-next-method))) (call-next-method))))
(defmethod component-depends-on ((o operation) (c component))
(cdr (assoc (type-of o) (component-in-order-to c))))) ; User-specified in-order dependencies
;;;; upward-operation, downward-operation, sideway-operation, selfward-operation ;;;; upward-operation, downward-operation, sideway-operation, selfward-operation
...@@ -146,8 +143,10 @@ the action (O . M) of O on module M will depends on each of (D . C) for each chi ...@@ -146,8 +143,10 @@ the action (O . M) of O on module M will depends on each of (D . C) for each chi
The default value for slot DOWNWARD-OPERATION is NIL, which designates the operation O itself. The default value for slot DOWNWARD-OPERATION is NIL, which designates the operation O itself.
E.g. in order for a MODULE to be loaded with LOAD-OP (resp. compiled with COMPILE-OP), all the E.g. in order for a MODULE to be loaded with LOAD-OP (resp. compiled with COMPILE-OP), all the
children of the MODULE must have been loaded with LOAD-OP (resp. compiled with COMPILE-OP.")) children of the MODULE must have been loaded with LOAD-OP (resp. compiled with COMPILE-OP."))
(defun downward-operation-depends-on (o c)
`((,(or (downward-operation o) o) ,@(component-children c))))
(defmethod component-depends-on ((o downward-operation) (c parent-component)) (defmethod component-depends-on ((o downward-operation) (c parent-component))
`((,(or (downward-operation o) o) ,@(component-children c)) ,@(call-next-method))) `(,@(downward-operation-depends-on o c) ,@(call-next-method)))
(defclass upward-operation (operation) (defclass upward-operation (operation)
((upward-operation ((upward-operation
...@@ -161,9 +160,10 @@ E.g. in order for a COMPONENT to be prepared for loading or compiling with PREPA ...@@ -161,9 +160,10 @@ E.g. in order for a COMPONENT to be prepared for loading or compiling with PREPA
must first be prepared for loading or compiling with PREPARE-OP.")) must first be prepared for loading or compiling with PREPARE-OP."))
;; For backward-compatibility reasons, a system inherits from module and is a child-component ;; For backward-compatibility reasons, a system inherits from module and is a child-component
;; so we must guard against this case. ASDF4: remove that. ;; so we must guard against this case. ASDF4: remove that.
(defun upward-operation-depends-on (o c)
(if-let (p (component-parent c)) `((,(or (upward-operation o) o) ,p))))
(defmethod component-depends-on ((o upward-operation) (c child-component)) (defmethod component-depends-on ((o upward-operation) (c child-component))
`(,@(if-let (p (component-parent c)) `(,@(upward-operation-depends-on o c) ,@(call-next-method)))
`((,(or (upward-operation o) o) ,p))) ,@(call-next-method)))
(defclass sideway-operation (operation) (defclass sideway-operation (operation)
((sideway-operation ((sideway-operation
...@@ -175,11 +175,12 @@ designates operation S (where NIL designates O itself), then the action (O . C) ...@@ -175,11 +175,12 @@ designates operation S (where NIL designates O itself), then the action (O . C)
depends on each of (S . D) where D is a declared dependency of C. depends on each of (S . D) where D is a declared dependency of C.
E.g. in order for a COMPONENT to be prepared for loading or compiling with PREPARE-OP, E.g. in order for a COMPONENT to be prepared for loading or compiling with PREPARE-OP,
each of its declared dependencies must first be loaded as by LOAD-OP.")) each of its declared dependencies must first be loaded as by LOAD-OP."))
(defmethod component-depends-on ((o sideway-operation) (c component)) (defun sideway-operation-depends-on (o c)
`((,(or (sideway-operation o) o) `((,(or (sideway-operation o) o)
,@(loop :for dep :in (component-sideway-dependencies c) ,@(loop :for dep :in (component-sideway-dependencies c)
:collect (resolve-dependency-spec c dep))) :collect (resolve-dependency-spec c dep)))))
,@(call-next-method))) (defmethod component-depends-on ((o sideway-operation) (c component))
`(,@(sideway-operation-depends-on o c) ,@(call-next-method)))
(defclass selfward-operation (operation) (defclass selfward-operation (operation)
((selfward-operation ((selfward-operation
...@@ -192,14 +193,14 @@ A operation-designator designates a singleton list of the designated operation; ...@@ -192,14 +193,14 @@ A operation-designator designates a singleton list of the designated operation;
a list of operation-designators designates the list of designated operations; a list of operation-designators designates the list of designated operations;
NIL is not a valid operation designator in that context. NIL is not a valid operation designator in that context.
E.g. before a component may be loaded by LOAD-OP, it must have been compiled by COMPILE-OP.")) E.g. before a component may be loaded by LOAD-OP, it must have been compiled by COMPILE-OP."))
(defun selfward-operation-depends-on (o c)
(loop :for op :in (ensure-list (selfward-operation o)) :collect `(,op ,c)))
(defmethod component-depends-on ((o selfward-operation) (c component)) (defmethod component-depends-on ((o selfward-operation) (c component))
`(,@(loop :for op :in (ensure-list (selfward-operation o)) `(,@(selfward-operation-depends-on o c) ,@(call-next-method)))
:collect `(,op ,c))
,@(call-next-method)))
(defclass non-propagating-operation (operation) (defclass non-propagating-operation (operation)
() ()
(:documentation "A NON-PROPAGATING-OPERATION is an operation that propagates (:documentation "A NON-PROPAGATING-OPERATION is an operation that propagates
no dependencies whatsoever. It is supplied in order that the programmer be able no dependencies whatsoever. It is supplied in order that the programmer be able
to specify that s/he is intentionally specifying an operation which invokes no to specify that s/he is intentionally specifying an operation which invokes no
dependencies."))) dependencies.")))
...@@ -208,40 +209,47 @@ dependencies."))) ...@@ -208,40 +209,47 @@ dependencies.")))
;;;--------------------------------------------------------------------------- ;;;---------------------------------------------------------------------------
;;; Help programmers catch obsolete OPERATION subclasses ;;; Help programmers catch obsolete OPERATION subclasses
;;;--------------------------------------------------------------------------- ;;;---------------------------------------------------------------------------
(define-condition operation-definition-error (simple-error) (with-upgradability ()
() (define-condition operation-definition-warning (simple-warning)
(:documentation "Error conditions related to incorrect definitions of ()
OPERATION objects.")) (:documentation "Warning condition related to definition of obsolete OPERATION objects."))
(defmethod initialize-instance :before ((obj operation) &key)
(unless (define-condition operation-definition-error (simple-error)
(loop :for x :in '(downward-operation upward-operation sideway-operation ()
selfward-operation non-propagating-operation (:documentation "Error condition related to definition of incorrect OPERATION objects."))
;; the following is a special case
build-op) (defmethod initialize-instance :before ((o operation) &key)
:when (typep obj x) ;; build-op is a special case.
:return t (unless (typep o '(or downward-operation upward-operation sideway-operation
:finally (return nil)) selfward-operation non-propagating-operation build-op))
(error 'operation-definition-error (warn 'operation-definition-warning
:format-control :format-control
"No dependency propagating scheme specified for operation ~a.~ "No dependency propagating scheme specified for operation class ~S.
This is likely because the OPERATION subclass of this object has not been ~ The class needs to be updated for ASDF 3.1 and specify appropriate propagation mixins."
updated for ASDF 3." :format-arguments (list (type-of o)))))
:format-arguments (list obj))))
(defmethod initialize-instance :before ((o non-propagating-operation) &key)
(defmethod initialize-instance :before ((obj non-propagating-operation) &key) (when (typep o '(or downward-operation upward-operation sideway-operation selfward-operation))
(when (error 'operation-definition-error
(loop :for x :in '(downward-operation upward-operation sideway-operation :format-control
selfward-operation) "Inconsistent class: ~S
:when (typep obj x) NON-PROPAGATING-OPERATION is incompatible with propagating operation classes as superclasses."
:return t :format-arguments
:finally (return nil)) (list (type-of o)))))
(error 'operation-definition-error
:format-control (defmethod component-depends-on ((o operation) (c component))
"Inconsistent class: ~a No class should have both NON-PROPAGATING-OPERATION and a propagating `(;; Normal behavior, to allow user-specified in-order-to dependencies
operation class as superclasses." ,@(cdr (assoc (type-of o) (component-in-order-to c)))
:format-arguments ;; For backward-compatibility with ASDF2, any operation that doesn't specify propagation
(list ;; or non-propagation through an appropriate mixin will be downward and sideway.
(class-name (class-of obj)))))) ,@(unless (typep o '(or downward-operation upward-operation sideway-operation
selfward-operation non-propagating-operation build-op))
`(,@(downward-operation-depends-on o c)
,@(sideway-operation-depends-on o c)))))
(defmethod downward-operation ((o operation)) nil)
(defmethod sideway-operation ((o operation)) nil))
;;;--------------------------------------------------------------------------- ;;;---------------------------------------------------------------------------
;;; End of OPERATION class checking ;;; End of OPERATION class checking
......
...@@ -121,7 +121,7 @@ ...@@ -121,7 +121,7 @@
#:circular-dependency ; errors #:circular-dependency ; errors
#:duplicate-names #:non-toplevel-system #:non-system-system #:duplicate-names #:non-toplevel-system #:non-system-system
#:package-system-missing-package-error #:package-system-missing-package-error
#:operation-definition-error #:operation-definition-warning #:operation-definition-error
#:try-recompiling #:try-recompiling
#:retry #:retry
......
...@@ -53,20 +53,10 @@ ...@@ -53,20 +53,10 @@
(loop :for class :in *good-classes* (loop :for class :in *good-classes*
:do (assert (make-instance class))) :do (assert (make-instance class)))
(assert (signals operation-definition-warning
(catch 'op-def-error (make-instance 'my-unupdated-operation))
(handler-bind ((operation-definition-error #'(lambda (e)
(declare (ignore e))
(throw 'op-def-error t))))
(make-instance 'my-unupdated-operation)
nil)))
(assert (signals operation-definition-error
(catch 'op-def-error (make-instance 'my-incoherent-operation))
(handler-bind ((operation-definition-error #'(lambda (e)
(declare (ignore e))
(throw 'op-def-error t))))
(make-instance 'my-incoherent-operation)
nil)))
(assert (make-instance 'my-good-operation)) (assert (make-instance 'my-good-operation))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment