From a4f598b61543e9ea024faafd1586019a9e040f62 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Mon, 17 Feb 2014 21:34:26 -0500 Subject: [PATCH] Don't error out when PERFORM'ing a nonsensically propagated legacy operation. (If it's not backward, it's not compatible.) --- action.lisp | 9 ++++++--- test/test-operation-classes.script | 2 ++ 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/action.lisp b/action.lisp index 67725bd9..431dc6c8 100644 --- a/action.lisp +++ b/action.lisp @@ -377,9 +377,12 @@ in some previous image, or T if it needs to be done.") (defmethod perform ((o operation) (c parent-component)) nil) (defmethod perform ((o operation) (c source-file)) - (sysdef-error - (compatfmt "~@<Required method PERFORM not implemented for operation ~A, component ~A~@:>") - (class-of o) (class-of c))) + ;; For backward compatibility, don't error on operations that don't specify propagation. + (when (typep o '(or downward-operation upward-operation sideway-operation + selfward-operation non-propagating-operation)) + (sysdef-error + (compatfmt "~@<Required method ~S not implemented for ~/asdf-action:format-action/~@:>") + 'perform (cons o c)))) (defmethod perform-with-restarts (operation component) ;; TOO verbose, especially as the default. Add your own :before method diff --git a/test/test-operation-classes.script b/test/test-operation-classes.script index 1d569870..c7599d15 100644 --- a/test/test-operation-classes.script +++ b/test/test-operation-classes.script @@ -71,3 +71,5 @@ (trivial-operation "test-asdf/test-module-depend" "quux" "file3mod" "file3") (trivial-operation "test-asdf/test-module-depend" "quux" "file3mod") (trivial-operation "test-asdf/test-module-depend" "quux"))) + +(operate 'trivial-operation 'test-asdf/test-module-depend) -- GitLab