From 8fa22cd5511ab683b85d9e2d91d63fc7ca8623ec Mon Sep 17 00:00:00 2001
From: "Robert P. Goldman" <rpgoldman@gmail.com>
Date: Mon, 20 Jan 2014 17:26:42 -0600
Subject: [PATCH] Raise a continuable error when instantiating an unpatched
 OPERATION.

The behavior of OPERATION has changed: previously it would act roughly like
LOAD-OP, and automatically have dependencies, but now that behavior has been
removed in a clean-up. In order to support programmers, we attempt to detect
programmer-defined OPERATION subclasses and signal an error if we believe they
are unpatched.

The new dependency-handling is implemented in the classes DOWNWARD-OPERATION,
UPWARD-OPERATION, SIDEWAY-OPERATION, SELFWARD-OPERATION, and the newly-added
NON-PROPAGATING-OPERATION.

To detect unpatched OPERATION classes, when we are instantiating an OPERATION,
we check to make sure it has one of the above classes as a superclass.  If it
does not, we raise a continuable error.  This is done in an INITIALIZE-INSTANCE
:BEFORE method on OPERATION. We considered trying to detect the definition of
OPERATION subclasses, but because the MOP is not standard, that approach was
rejected as infeasible.

Add NON-PROPAGATING-OPERATION as superclass where needed.

Further checks and some documentation.

Thanks to Fare for advice.

Check that no OPERATION is both propagating and non-propagating.

Thanks to Fare for the suggestion.
---
 action.lisp             | 21 ++++++++++++++++++---
 bundle.lisp             | 13 ++++++++-----
 concatenate-source.lisp |  2 +-
 3 files changed, 27 insertions(+), 9 deletions(-)

diff --git a/action.lisp b/action.lisp
index 5ecf77ee..faecf57a 100644
--- a/action.lisp
+++ b/action.lisp
@@ -9,7 +9,7 @@
   (:export
    #:action #:define-convenience-action-methods
    #:explain #:action-description
-   #:downward-operation #:upward-operation #:sideway-operation #:selfward-operation
+   #:downward-operation #:upward-operation #:sideway-operation #:selfward-operation #:non-propagating-operation
    #:component-depends-on
    #:input-files #:output-files #:output-file #:operation-done-p
    #:action-status #:action-stamp #:action-done-p
@@ -208,14 +208,29 @@ dependencies.")))
 (defmethod initialize-instance :before ((obj operation) &key)
   (unless 
       (loop :for x :in '(downward-operation upward-operation sideway-operation
-                                            selfward-operation non-propagating-operation)
+                                            selfward-operation non-propagating-operation
+                                            ;; the following is a special case
+                                            build-op)
             :when (typep obj x)
             :return t
             :finally (return nil))
     (error "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." 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 "Inconsistent class: ~a No class should have both NON-PROPAGATING-OPERATION and a propagating 
+operation class as superclasses." (class-name (class-of obj)))))
+
+;;;---------------------------------------------------------------------------
+;;; End of OPERATION class checking
+;;;---------------------------------------------------------------------------
 
 
 ;;;; Inputs, Outputs, and invisible dependencies
diff --git a/bundle.lisp b/bundle.lisp
index 8cb31bcc..fba0f5cf 100644
--- a/bundle.lisp
+++ b/bundle.lisp
@@ -51,7 +51,7 @@
 
   (defclass no-ld-flags-op (operation) ())
 
-  (defclass lib-op (bundle-compile-op no-ld-flags-op)
+  (defclass lib-op (bundle-compile-op no-ld-flags-op non-propagating-operation)
     ((bundle-type :initform #+(or ecl mkcl) :lib #-(or ecl mkcl) :no-output-file))
     (:documentation #+(or ecl mkcl) "compile the system and produce linkable (.a) library for it."
      #-(or ecl mkcl) "just compile the system"))
@@ -78,10 +78,10 @@
     ((selfward-operation :initform '(monolithic-fasl-op monolithic-lib-op) :allocation :class))
     (:documentation "produce fasl and asd files for combined system and dependencies."))
 
-  (defclass monolithic-fasl-op (monolithic-bundle-compile-op basic-fasl-op) ()
+  (defclass monolithic-fasl-op (monolithic-bundle-compile-op basic-fasl-op non-propagating-operation) ()
     (:documentation "Create a single fasl for the system and its dependencies."))
 
-  (defclass monolithic-lib-op (monolithic-bundle-compile-op basic-compile-op  no-ld-flags-op)
+  (defclass monolithic-lib-op (monolithic-bundle-compile-op basic-compile-op non-propagating-operation no-ld-flags-op)
     ((bundle-type :initform #+(or ecl mkcl) :lib #-(or ecl mkcl) :no-output-file))
     (:documentation #+(or ecl mkcl) "Create a single linkable library for the system and its dependencies."
      #-(or ecl mkcl) "Compile a system and its dependencies."))
@@ -90,10 +90,13 @@
     ((bundle-type :initform :dll))
     (:documentation "Create a single dynamic (.so/.dll) library for the system and its dependencies."))
 
-  (defclass program-op #+(or mkcl ecl) (monolithic-bundle-compile-op)
+  ;; Fare reports that the PROGRAM-OP doesn't need any propagation on MKCL or
+  ;; ECL because the necessary dependency wrangling is done by other, earlier
+  ;; operations. [2014/01/20:rpg]
+  (defclass program-op #+(or mkcl ecl) (monolithic-bundle-compile-op non-propagating-operation)
             #-(or mkcl ecl) (monolithic-bundle-op selfward-operation)
     ((bundle-type :initform :program)
-     #-(or mkcl ecl) (selfward-operation :initform #-(or mkcl ecl) 'load-op))
+     #-(or mkcl ecl) (selfward-operation :initform 'load-op))
     (:documentation "create an executable file from the system and its dependencies"))
 
   (defun bundle-pathname-type (bundle-type)
diff --git a/concatenate-source.lisp b/concatenate-source.lisp
index 7be26fa7..36d08993 100644
--- a/concatenate-source.lisp
+++ b/concatenate-source.lisp
@@ -36,7 +36,7 @@
   (defclass load-compiled-concatenated-source-op (basic-load-compiled-concatenated-source-op)
     ((selfward-operation :initform '(prepare-op compile-concatenated-source-op) :allocation :class)))
 
-  (defclass monolithic-concatenate-source-op (basic-concatenate-source-op monolithic-bundle-op) ())
+  (defclass monolithic-concatenate-source-op (basic-concatenate-source-op monolithic-bundle-op non-propagating-operation) ())
   (defclass monolithic-load-concatenated-source-op (basic-load-concatenated-source-op)
     ((selfward-operation :initform 'monolithic-concatenate-source-op :allocation :class)))
   (defclass monolithic-compile-concatenated-source-op (basic-compile-concatenated-source-op)
-- 
GitLab