Commit eb2da723 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

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
......@@ -18,7 +18,7 @@
#:traverse-actions #:traverse-sub-actions #:required-components ;; in plan
#:action-path #:find-action #:stamp #:done-p
;; condition
#:operation-definition-error
#:operation-definition-warning #:operation-definition-error
))
(in-package :asdf/action)
......@@ -127,10 +127,7 @@ You can put together sentences using this phrase."))
(defmethod component-depends-on :around ((o operation) (c component))
(do-asdf-cache `(component-depends-on ,o ,c)
(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
(call-next-method))))
;;;; 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
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
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))
`((,(or (downward-operation o) o) ,@(component-children c)) ,@(call-next-method)))
`(,@(downward-operation-depends-on o c) ,@(call-next-method)))
(defclass upward-operation (operation)
((upward-operation
......@@ -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."))
;; For backward-compatibility reasons, a system inherits from module and is a child-component
;; 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))
`(,@(if-let (p (component-parent c))
`((,(or (upward-operation o) o) ,p))) ,@(call-next-method)))
`(,@(upward-operation-depends-on o c) ,@(call-next-method)))
(defclass sideway-operation (operation)
((sideway-operation
......@@ -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.
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."))
(defmethod component-depends-on ((o sideway-operation) (c component))
(defun sideway-operation-depends-on (o c)
`((,(or (sideway-operation o) o)
,@(loop :for dep :in (component-sideway-dependencies c)
:collect (resolve-dependency-spec c dep)))
,@(call-next-method)))
:collect (resolve-dependency-spec c dep)))))
(defmethod component-depends-on ((o sideway-operation) (c component))
`(,@(sideway-operation-depends-on o c) ,@(call-next-method)))
(defclass selfward-operation (operation)
((selfward-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;
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."))
(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))
`(,@(loop :for op :in (ensure-list (selfward-operation o))
:collect `(,op ,c))
,@(call-next-method)))
`(,@(selfward-operation-depends-on o c) ,@(call-next-method)))
(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
to specify that s/he is intentionally specifying an operation which invokes no
dependencies.")))
......@@ -208,40 +209,47 @@ dependencies.")))
;;;---------------------------------------------------------------------------
;;; Help programmers catch obsolete OPERATION subclasses
;;;---------------------------------------------------------------------------
(define-condition operation-definition-error (simple-error)
()
(:documentation "Error conditions related to incorrect definitions of
OPERATION objects."))
(defmethod initialize-instance :before ((obj operation) &key)
(unless
(loop :for x :in '(downward-operation upward-operation sideway-operation
selfward-operation non-propagating-operation
;; the following is a special case
build-op)
:when (typep obj x)
:return t
:finally (return nil))
(error 'operation-definition-error
:format-control
"No dependency propagating scheme specified for operation ~a.~
This is likely because the OPERATION subclass of this object has not been ~
updated for ASDF 3."
:format-arguments (list obj))))
(defmethod initialize-instance :before ((obj non-propagating-operation) &key)
(when
(loop :for x :in '(downward-operation upward-operation sideway-operation
selfward-operation)
:when (typep obj x)
:return t
:finally (return nil))
(error 'operation-definition-error
:format-control
"Inconsistent class: ~a No class should have both NON-PROPAGATING-OPERATION and a propagating
operation class as superclasses."
:format-arguments
(list
(class-name (class-of obj))))))
(with-upgradability ()
(define-condition operation-definition-warning (simple-warning)
()
(:documentation "Warning condition related to definition of obsolete OPERATION objects."))
(define-condition operation-definition-error (simple-error)
()
(:documentation "Error condition related to definition of incorrect OPERATION objects."))
(defmethod initialize-instance :before ((o operation) &key)
;; build-op is a special case.
(unless (typep o '(or downward-operation upward-operation sideway-operation
selfward-operation non-propagating-operation build-op))
(warn 'operation-definition-warning
:format-control
"No dependency propagating scheme specified for operation class ~S.
The class needs to be updated for ASDF 3.1 and specify appropriate propagation mixins."
:format-arguments (list (type-of o)))))
(defmethod initialize-instance :before ((o non-propagating-operation) &key)
(when (typep o '(or downward-operation upward-operation sideway-operation selfward-operation))
(error 'operation-definition-error
:format-control
"Inconsistent class: ~S
NON-PROPAGATING-OPERATION is incompatible with propagating operation classes as superclasses."
:format-arguments
(list (type-of o)))))
(defmethod component-depends-on ((o operation) (c component))
`(;; Normal behavior, to allow user-specified in-order-to dependencies
,@(cdr (assoc (type-of o) (component-in-order-to c)))
;; For backward-compatibility with ASDF2, any operation that doesn't specify propagation
;; or non-propagation through an appropriate mixin will be downward and sideway.
,@(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
......
......@@ -121,7 +121,7 @@
#:circular-dependency ; errors
#:duplicate-names #:non-toplevel-system #:non-system-system
#:package-system-missing-package-error
#:operation-definition-error
#:operation-definition-warning #:operation-definition-error
#:try-recompiling
#:retry
......
......@@ -53,20 +53,10 @@
(loop :for class :in *good-classes*
:do (assert (make-instance class)))
(assert
(catch 'op-def-error
(handler-bind ((operation-definition-error #'(lambda (e)
(declare (ignore e))
(throw 'op-def-error t))))
(make-instance 'my-unupdated-operation)
nil)))
(signals operation-definition-warning
(make-instance 'my-unupdated-operation))
(assert
(catch 'op-def-error
(handler-bind ((operation-definition-error #'(lambda (e)
(declare (ignore e))
(throw 'op-def-error t))))
(make-instance 'my-incoherent-operation)
nil)))
(signals operation-definition-error
(make-instance 'my-incoherent-operation))
(assert (make-instance 'my-good-operation))
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