Commit 8e68ac22 by Francois-Rene Rideau

Fix upgrade issue with asdf/bundle.

Change implementation strategy for operation metadata methods
bundle-type, gather-operation and gather-type.

Upgrading from 3.1.7 or earlier yielded incorrect values for the metadata slots
of the bundle operation classes, e.g.
(gather-type (make-operation 'monolithic-lib-op))) was stuck to :STATIC-LIBRARY
instead of its correct value :OBJECT since 3.2.0.
The reason was that we were storing the value for this method in the :initform
for the slot gather-type, which started as clever way of defining it as part of
the DEFCLASS form for the class itself; however, this usage pattern does not
work well with hot code upgrade: if the :initform changes during ASDF upgrade,
the slot is already initialized, so its value isn't updated. That would require
a method on UPDATE-INSTANCE-FOR-REDEFINED-CLASS, which hopefully should be
invoked despite the fact that the shape of the class hasn't changed.
A new slot won't be allocated because (a) we ensure that our operation classes
are singleton classes using an *operations* cache, so objects are not
reallocated, and (b) we define our slots with an :allocation :class, anyway.
Remarkably, at least *some* of our changes in :initform have worked anyway,
because when we transitioned allocation from :instance (default) to :class,
that transition did force the computation of the new :initform, so the problem
was hidden. But we're already out of luck with this upgrade from 3.1.7,
and we must find a real solution.

The Right Thing(tm) to do is to use DEFMETHOD to define specialized values.
This commit does exactly that for the slots defined in bundle.lisp
(and also used in concatenate-source.lisp). Ideally, we'd also do that
for the slots defined in action.lisp and used in lisp-action.lisp, bundle.lisp
and concatenate-source.lisp --- but there might or might not be clients
in Quicklisp (or beyond Quicklisp) that this change would break.
We must check backward compatibility, make sufficient announcement, etc. Sigh.
parent c54265da
......@@ -22,12 +22,9 @@
(in-package :asdf/bundle)
(with-upgradability ()
(defclass bundle-op (operation)
;; NB: use of instance-allocated slots for operations is DEPRECATED
;; and only supported in a temporary fashion for backward compatibility.
;; Supported replacement: Define slots on program-system instead.
((bundle-type :initform :no-output-file :reader bundle-type :allocation :class))
(defclass bundle-op (operation) ()
(:documentation "base class for operations that bundle outputs from multiple components"))
(defgeneric bundle-type (bundle-op))
(defclass monolithic-op (operation) ()
(:documentation "A MONOLITHIC operation operates on a system *and all of its
......@@ -68,10 +65,11 @@ itself."))
(defclass link-op (bundle-op) ()
(:documentation "Abstract operation for linking files together"))
(defclass gather-operation (bundle-op)
((gather-operation :initform nil :allocation :class :reader gather-operation)
(gather-type :initform :no-output-file :allocation :class :reader gather-type))
(defclass gather-operation (bundle-op) ()
(:documentation "Abstract operation for gathering many input files from a system"))
(defgeneric gather-operation (gather-operation))
(defmethod gather-operation ((o gather-operation)) nil)
(defgeneric gather-type (gather-operation))
(defun operation-monolithic-p (op)
(typep op 'monolithic-op))
......@@ -108,11 +106,12 @@ itself."))
`((,go ,@deps) ,@(call-next-method))))
;; Create a single fasl for the entire library
(defclass basic-compile-bundle-op (bundle-op basic-compile-op)
((gather-type :initform #-(or clasp ecl mkcl) :fasl #+(or clasp ecl mkcl) :object
:allocation :class)
(bundle-type :initform :fasb :allocation :class))
(defclass basic-compile-bundle-op (bundle-op basic-compile-op) ()
(:documentation "Base class for compiling into a bundle"))
(defmethod bundle-type ((o basic-compile-bundle-op)) :fasb)
(defmethod gather-type ((o basic-compile-bundle-op))
#-(or clasp ecl mkcl) :fasl
#+(or clasp ecl mkcl) :object)
;; Analog to prepare-op, for load-bundle-op and compile-bundle-op
(defclass prepare-bundle-op (sideway-operation)
......@@ -121,9 +120,7 @@ itself."))
:allocation :class))
(:documentation "Operation class for loading the bundles of a system's dependencies"))
(defclass lib-op (link-op gather-operation non-propagating-operation)
((gather-type :initform :object :allocation :class)
(bundle-type :initform :lib :allocation :class))
(defclass lib-op (link-op gather-operation non-propagating-operation) ()
(:documentation "Compile the system and produce a linkable static library (.a/.lib)
for all the linkable object files associated with the system. Compare with DLL-OP.
......@@ -132,6 +129,8 @@ written in C or another language with a compiler producing linkable object files
On CLASP, ECL, MKCL, these object files _also_ include the contents of Lisp files
themselves. In any case, this operation will produce what you need to further build
a static runtime for your system, or a dynamic library to load in an existing runtime."))
(defmethod bundle-type ((o lib-op)) :lib)
(defmethod gather-type ((o lib-op)) :object)
;; What works: on ECL, CLASP(?), MKCL, we link the many .o files from the system into the .so;
;; on other implementations, we combine (usually concatenate) the .fasl files into one.
......@@ -155,11 +154,11 @@ faster and more resource efficient."))
;; we'd have to have the monolithic-op not inherit from the main op,
;; but instead inherit from a basic-FOO-op as with basic-compile-bundle-op above.
(defclass dll-op (link-op gather-operation non-propagating-operation)
((gather-type :initform :object :allocation :class)
(bundle-type :initform :dll :allocation :class))
(defclass dll-op (link-op gather-operation non-propagating-operation) ()
(:documentation "Compile the system and produce a dynamic loadable library (.so/.dll)
for all the linkable object files associated with the system. Compare with LIB-OP."))
(defmethod bundle-type ((o dll-op)) :dll)
(defmethod gather-type ((o dll-op)) :object)
(defclass deliver-asd-op (basic-compile-op selfward-operation)
((selfward-operation
......@@ -188,27 +187,25 @@ for all the linkable object files associated with the system. Compare with LIB-O
((selfward-operation :initform 'monolithic-compile-bundle-op :allocation :class))
(:documentation "Load a single fasl for the system and its dependencies."))
(defclass monolithic-lib-op (lib-op monolithic-bundle-op non-propagating-operation)
((gather-type :initform :object :allocation :class))
(defclass monolithic-lib-op (lib-op monolithic-bundle-op non-propagating-operation) ()
(:documentation "Compile the system and produce a linkable static library (.a/.lib)
for all the linkable object files associated with the system or its dependencies. See LIB-OP."))
(defclass monolithic-dll-op (dll-op monolithic-bundle-op non-propagating-operation)
((gather-type :initform :object :allocation :class))
(defclass monolithic-dll-op (dll-op monolithic-bundle-op non-propagating-operation) ()
(:documentation "Compile the system and produce a dynamic loadable library (.so/.dll)
for all the linkable object files associated with the system or its dependencies. See LIB-OP"))
(defclass image-op (monolithic-bundle-op selfward-operation
#+(or clasp ecl mkcl) link-op #+(or clasp ecl mkcl) gather-operation)
((bundle-type :initform :image :allocation :class)
(gather-operation :initform 'lib-op :allocation :class)
#+(or clasp ecl mkcl) (gather-type :initform :static-library :allocation :class)
(selfward-operation :initform '(#-(or clasp ecl mkcl) load-op) :allocation :class))
((selfward-operation :initform '(#-(or clasp ecl mkcl) load-op) :allocation :class))
(:documentation "create an image file from the system and its dependencies"))
(defmethod bundle-type ((o image-op)) :image)
#+(or clasp ecl mkcl) (defmethod gather-operation ((o image-op)) 'lib-op)
#+(or clasp ecl mkcl) (defmethod gather-type ((o image-op)) :static-library)
(defclass program-op (image-op)
((bundle-type :initform :program :allocation :class))
(defclass program-op (image-op) ()
(:documentation "create an executable file from the system and its dependencies"))
(defmethod bundle-type ((o program-op)) :program)
;; From the ASDF-internal bundle-type identifier, get a filesystem-usable pathname type.
(defun bundle-pathname-type (bundle-type)
......
......@@ -23,8 +23,8 @@
;;;
(with-upgradability ()
;; Base classes for both regular and monolithic concatenate-source operations
(defclass basic-concatenate-source-op (bundle-op)
((bundle-type :initform "lisp" :allocation :class)))
(defclass basic-concatenate-source-op (bundle-op) ())
(defmethod bundle-type ((o basic-concatenate-source-op)) "lisp")
(defclass basic-load-concatenated-source-op (basic-load-op selfward-operation) ())
(defclass basic-compile-concatenated-source-op (basic-compile-op selfward-operation) ())
(defclass basic-load-compiled-concatenated-source-op (basic-load-op selfward-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