Commit 8e0ec0e9 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Stop fmakunbound'ing defgeneric's past the upgrade trigger

If we fmakunbound a defgeneric, we lose any user-defined method on the function
and must therefore reload any and every system that might have defined methods
on it. We must therefore not fmakunbound past the forward compatibility upgrade
trigger, only before. Adjust our code accordingly. Conservative bounds are used
in *oldest-forward-compatible-asdf-version* and redefined-functions that should
probably be refined after some inspection of old versions.

This is a response to https://bugs.launchpad.net/asdf/+bug/1631771
parent b14722e0
...@@ -117,7 +117,7 @@ Use it in FORMAT control strings as ~/asdf-action:format-action/" ...@@ -117,7 +117,7 @@ Use it in FORMAT control strings as ~/asdf-action:format-action/"
;;;; Dependencies ;;;; Dependencies
(with-upgradability () (with-upgradability ()
(defgeneric* (component-depends-on) (operation component) ;; ASDF4: rename to component-dependencies (defgeneric component-depends-on (operation component) ;; ASDF4: rename to component-dependencies
(:documentation (:documentation
"Returns a list of dependencies needed by the component to perform "Returns a list of dependencies needed by the component to perform
the operation. A dependency has one of the following forms: the operation. A dependency has one of the following forms:
...@@ -270,7 +270,7 @@ The class needs to be updated for ASDF 3.1 and specify appropriate propagation m ...@@ -270,7 +270,7 @@ The class needs to be updated for ASDF 3.1 and specify appropriate propagation m
;;;; Inputs, Outputs, and invisible dependencies ;;;; Inputs, Outputs, and invisible dependencies
(with-upgradability () (with-upgradability ()
(defgeneric* (output-files) (operation component) (defgeneric output-files (operation component)
(:documentation "Methods for this function return two values: a list of output files (:documentation "Methods for this function return two values: a list of output files
corresponding to this action, and a boolean indicating if they have already been subjected corresponding to this action, and a boolean indicating if they have already been subjected
to relevant output translations and should not be further translated. to relevant output translations and should not be further translated.
...@@ -278,13 +278,13 @@ to relevant output translations and should not be further translated. ...@@ -278,13 +278,13 @@ to relevant output translations and should not be further translated.
Methods on PERFORM *must* call this function to determine where their outputs are to be located. Methods on PERFORM *must* call this function to determine where their outputs are to be located.
They may rely on the order of the files to discriminate between outputs. They may rely on the order of the files to discriminate between outputs.
")) "))
(defgeneric* (input-files) (operation component) (defgeneric input-files (operation component)
(:documentation "A list of input files corresponding to this action. (:documentation "A list of input files corresponding to this action.
Methods on PERFORM *must* call this function to determine where their inputs are located. Methods on PERFORM *must* call this function to determine where their inputs are located.
They may rely on the order of the files to discriminate between inputs. They may rely on the order of the files to discriminate between inputs.
")) "))
(defgeneric* (operation-done-p) (operation component) (defgeneric operation-done-p (operation component)
(:documentation "Returns a boolean which is NIL if the action must be performed (again).")) (:documentation "Returns a boolean which is NIL if the action must be performed (again)."))
(define-convenience-action-methods output-files (operation component)) (define-convenience-action-methods output-files (operation component))
(define-convenience-action-methods input-files (operation component)) (define-convenience-action-methods input-files (operation component))
...@@ -294,8 +294,7 @@ They may rely on the order of the files to discriminate between inputs. ...@@ -294,8 +294,7 @@ They may rely on the order of the files to discriminate between inputs.
t) t)
;; Translate output files, unless asked not to. Memoize the result. ;; Translate output files, unless asked not to. Memoize the result.
(defmethod output-files :around (operation component) (defmethod output-files :around ((operation t) (component t))
operation component ;; hush genera, not convinced by declare ignorable(!)
(do-asdf-cache `(output-files ,operation ,component) (do-asdf-cache `(output-files ,operation ,component)
(values (values
(multiple-value-bind (pathnames fixedp) (call-next-method) (multiple-value-bind (pathnames fixedp) (call-next-method)
...@@ -397,7 +396,7 @@ in some previous image, or T if it needs to be done.") ...@@ -397,7 +396,7 @@ in some previous image, or T if it needs to be done.")
;;;; Perform ;;;; Perform
(with-upgradability () (with-upgradability ()
(defgeneric* (perform) (operation component) (defgeneric perform (operation component)
(:documentation "PERFORM an action, consuming its input-files and building its output-files")) (:documentation "PERFORM an action, consuming its input-files and building its output-files"))
(define-convenience-action-methods perform (operation component)) (define-convenience-action-methods perform (operation component))
...@@ -418,7 +417,7 @@ in some previous image, or T if it needs to be done.") ...@@ -418,7 +417,7 @@ in some previous image, or T if it needs to be done.")
;; The restarts of the perform-with-restarts variant matter in an interactive context. ;; The restarts of the perform-with-restarts variant matter in an interactive context.
;; The retry strategies of p-w-r itself, and/or the background workers of a multiprocess build ;; The retry strategies of p-w-r itself, and/or the background workers of a multiprocess build
;; may call perform directly rather than call p-w-r. ;; may call perform directly rather than call p-w-r.
(defgeneric* (perform-with-restarts) (operation component) (defgeneric perform-with-restarts (operation component)
(:documentation "PERFORM an action in a context where suitable restarts are in place.")) (:documentation "PERFORM an action in a context where suitable restarts are in place."))
(defmethod perform-with-restarts (operation component) (defmethod perform-with-restarts (operation component)
(perform operation component)) (perform operation component))
......
...@@ -74,7 +74,7 @@ if that's whay you mean." ;;) ...@@ -74,7 +74,7 @@ if that's whay you mean." ;;)
;; TRAVERSE is the function used to compute a plan in ASDF 1 and 2. ;; TRAVERSE is the function used to compute a plan in ASDF 1 and 2.
;; It was never officially exposed but some people still used it. ;; It was never officially exposed but some people still used it.
(defgeneric* (traverse) (operation component &key &allow-other-keys) (defgeneric traverse (operation component &key &allow-other-keys)
(:documentation (:documentation
"Generate and return a plan for performing OPERATION on COMPONENT. "Generate and return a plan for performing OPERATION on COMPONENT.
...@@ -189,7 +189,7 @@ Please use UIOP:RUN-PROGRAM instead." ...@@ -189,7 +189,7 @@ Please use UIOP:RUN-PROGRAM instead."
;;; This method survives from ASDF 1, but really it is superseded by action-description. ;;; This method survives from ASDF 1, but really it is superseded by action-description.
(with-upgradability () (with-upgradability ()
(defgeneric* (explain) (operation component) (defgeneric explain (operation component)
(:documentation "Display a message describing an action. (:documentation "Display a message describing an action.
DEPRECATED. Use ASDF:ACTION-DESCRIPTION and/or ASDF::FORMAT-ACTION instead.")) DEPRECATED. Use ASDF:ACTION-DESCRIPTION and/or ASDF::FORMAT-ACTION instead."))
(defmethod explain ((o operation) (c component)) (defmethod explain ((o operation) (c component))
......
...@@ -303,7 +303,7 @@ or of opaque libraries shipped along the source code.")) ...@@ -303,7 +303,7 @@ or of opaque libraries shipped along the source code."))
:force :force-not :plan-class) ;; TODO: refactor so we don't mix plan and operation arguments :force :force-not :plan-class) ;; TODO: refactor so we don't mix plan and operation arguments
(operation-original-initargs instance)))) (operation-original-initargs instance))))
(defgeneric* (trivial-system-p) (component)) (defgeneric trivial-system-p (component))
(defun user-system-p (s) (defun user-system-p (s)
(and (typep s 'system) (and (typep s 'system)
......
...@@ -49,7 +49,7 @@ ...@@ -49,7 +49,7 @@
(:documentation "Top-level system containing the COMPONENT")) (:documentation "Top-level system containing the COMPONENT"))
(defgeneric component-pathname (component) (defgeneric component-pathname (component)
(:documentation "Pathname of the COMPONENT if any, or NIL.")) (:documentation "Pathname of the COMPONENT if any, or NIL."))
(defgeneric* (component-relative-pathname) (component) (defgeneric component-relative-pathname (component)
;; in ASDF4, rename that to component-specified-pathname ? ;; in ASDF4, rename that to component-specified-pathname ?
(:documentation "Specified pathname of the COMPONENT, (:documentation "Specified pathname of the COMPONENT,
intended to be merged with the pathname of that component's parent if any, using merged-pathnames*. intended to be merged with the pathname of that component's parent if any, using merged-pathnames*.
...@@ -78,7 +78,7 @@ or NIL for top-level components (a.k.a. systems)")) ...@@ -78,7 +78,7 @@ or NIL for top-level components (a.k.a. systems)"))
;; Deprecated: Backward compatible way of computing the FILE-TYPE of a component. ;; Deprecated: Backward compatible way of computing the FILE-TYPE of a component.
;; TODO: find users, have them stop using that, remove it for ASDF4. ;; TODO: find users, have them stop using that, remove it for ASDF4.
(defgeneric* (source-file-type) (component system) (defgeneric source-file-type (component system)
(:documentation "DEPRECATED. Use the FILE-TYPE of a COMPONENT instead.")) (:documentation "DEPRECATED. Use the FILE-TYPE of a COMPONENT instead."))
(define-condition system-definition-error (error) () (define-condition system-definition-error (error) ()
...@@ -232,7 +232,7 @@ typically but not necessarily representing the files in a subdirectory of the bu ...@@ -232,7 +232,7 @@ typically but not necessarily representing the files in a subdirectory of the bu
;;;; component pathnames ;;;; component pathnames
(with-upgradability () (with-upgradability ()
(defgeneric* (component-parent-pathname) (component) (defgeneric component-parent-pathname (component)
(:documentation "The pathname of the COMPONENT's parent, if any, or NIL")) (:documentation "The pathname of the COMPONENT's parent, if any, or NIL"))
(defmethod component-parent-pathname (component) (defmethod component-parent-pathname (component)
(component-pathname (component-parent component))) (component-pathname (component-parent component)))
......
...@@ -50,7 +50,7 @@ ...@@ -50,7 +50,7 @@
;;;; Finding components ;;;; Finding components
(with-upgradability () (with-upgradability ()
(defgeneric* (find-component) (base path &key registered) (defgeneric find-component (base path &key registered)
(:documentation "Find a component by resolving the PATH starting from BASE parent. (:documentation "Find a component by resolving the PATH starting from BASE parent.
If REGISTERED is true, only search currently registered systems.")) If REGISTERED is true, only search currently registered systems."))
(defgeneric resolve-dependency-combination (component combinator arguments) (defgeneric resolve-dependency-combination (component combinator arguments)
......
...@@ -16,7 +16,7 @@ ...@@ -16,7 +16,7 @@
(in-package :asdf/operate) (in-package :asdf/operate)
(with-upgradability () (with-upgradability ()
(defgeneric* (operate) (operation component &key &allow-other-keys) (defgeneric operate (operation component &key &allow-other-keys)
(:documentation (:documentation
"Operate does mainly four things for the user: "Operate does mainly four things for the user:
...@@ -208,7 +208,7 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms.")) ...@@ -208,7 +208,7 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms."))
(*modules-being-required* (cons module *modules-being-required*))) (*modules-being-required* (cons module *modules-being-required*)))
(assert (null (component-children s))) (assert (null (component-children s)))
;; CMUCL likes its module names to be all upcase. ;; CMUCL likes its module names to be all upcase.
(require #-cmucl module #+cmucl (string-upcase module)))) (require (nest #+cmucl (string-upcase) module))))
(defmethod resolve-dependency-combination (component (combinator (eql :require)) arguments) (defmethod resolve-dependency-combination (component (combinator (eql :require)) arguments)
(unless (and (length=n-p arguments 1) (unless (and (length=n-p arguments 1)
......
...@@ -230,7 +230,7 @@ after having found a .asd file? True by default.") ...@@ -230,7 +230,7 @@ after having found a .asd file? True by default.")
;;; Process the source-registry configuration ;;; Process the source-registry configuration
(defgeneric* (process-source-registry) (spec &key inherit register)) (defgeneric process-source-registry (spec &key inherit register))
(defun* (inherit-source-registry) (inherit &key register) (defun* (inherit-source-registry) (inherit &key register)
(when inherit (when inherit
......
...@@ -24,12 +24,12 @@ ...@@ -24,12 +24,12 @@
(with-upgradability () (with-upgradability ()
;; The method is actually defined in asdf/find-system, ;; The method is actually defined in asdf/find-system,
;; but we declare the function here to avoid a forward reference. ;; but we declare the function here to avoid a forward reference.
(defgeneric* (find-system) (system &optional error-p) (defgeneric find-system (system &optional error-p)
(:documentation "Given a system designator, find the actual corresponding system object. (:documentation "Given a system designator, find the actual corresponding system object.
If no system is found, then signal an error if ERROR-P is true (the default), or else return NIL. If no system is found, then signal an error if ERROR-P is true (the default), or else return NIL.
A system designator is usually a string (conventionally all lowercase) or a symbol, designating A system designator is usually a string (conventionally all lowercase) or a symbol, designating
the same system as its downcased name; it can also be a system object (designating itself).")) the same system as its downcased name; it can also be a system object (designating itself)."))
(defgeneric* (system-source-file :supersede #-clisp t #+clisp nil) (system) (defgeneric system-source-file (system)
(:documentation "Return the source file in which system is defined.")) (:documentation "Return the source file in which system is defined."))
;; This is bad design, but was the easiest kluge I found to let the user specify that ;; This is bad design, but was the easiest kluge I found to let the user specify that
;; some special actions create outputs at locations controled by the user that are not affected ;; some special actions create outputs at locations controled by the user that are not affected
......
...@@ -44,8 +44,12 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO ...@@ -44,8 +44,12 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
(list previous))) (list previous)))
;; This public variable will be bound shortly to the currently loaded version of ASDF. ;; This public variable will be bound shortly to the currently loaded version of ASDF.
(defvar *asdf-version* nil) (defvar *asdf-version* nil)
;; We need to clear systems from versions older than the one in this (private) parameter: ;; We need to clear systems from versions older than the one in this (private) parameter.
(defparameter *oldest-forward-compatible-asdf-version* "2.33") ;; 2.32.13 renames a slot in component. ;; The latest incompatible defclass is 2.32.13 renaming a slot in component;
;; the latest incompatible defgeneric is TBD;
;; there is a defgeneric => defun in 3.1.7.27 so lacking per-function fmakunbound for now,
;; this will be our cut-off version.
(defparameter *oldest-forward-compatible-asdf-version* "3.1.7.27")
;; Semi-private variable: a designator for a stream on which to output ASDF progress messages ;; Semi-private variable: a designator for a stream on which to output ASDF progress messages
(defvar *verbose-out* nil) (defvar *verbose-out* nil)
;; Private function by which ASDF outputs progress messages and warning messages: ;; Private function by which ASDF outputs progress messages and warning messages:
...@@ -103,13 +107,23 @@ previously-loaded version of ASDF." ...@@ -103,13 +107,23 @@ previously-loaded version of ASDF."
;;; Upon upgrade, specially frob some functions and classes that are being incompatibly redefined ;;; Upon upgrade, specially frob some functions and classes that are being incompatibly redefined
(when-upgrading () (when-upgrading ()
(let ((redefined-functions ;; gf signature and/or semantics changed incompatibly. Oops. (let ((redefined-functions ;; gf signature and/or semantics changed incompatibly. Oops.
;; NB: it's too late to do anything about functions in UIOP! ;; NB: it's too late to do anything about functions in UIOP!
;; If you introduce some critically incompatibility there, you must change name. ;; If you introduce some critical incompatibility there, you must change the function name.
'()) ;; empty now that we don't unintern, but wholly punt on ASDF 2.26 or earlier. ;; TODO: We should probably remove a few of these functions now that we wholly punt
;; on ASDF 2.26 or earlier; however determining which for sure is a huge pain,
;; because it requires inspecting each and every release since 2.27 or so.
;; Note that we don't include the defgeneric=>defun, because they are
;; done directly with defun* and need not trigger a punt on data.
;; So these are only for defun=>defgeneric, modified defgeneric and *method removed*.
'(#:component-depends-on #:output-files #:input-files #:operation-done-p
#:perform #:perform-with-restarts #:traverse #:explain #:operate
#:trivial-system-p #:component-relative-pathname #:source-file-type
#:component-parent-pathname #:find-component #:process-source-registry
#:find-system #:system-source-file))
(redefined-classes (redefined-classes
;; redefining the classes causes interim circularities ;; redefining the classes causes interim circularities
;; with the old ASDF during upgrade, and many implementations bork ;; with the old ASDF during upgrade, and many implementations bork
'((#:compile-concatenated-source-op (#:operation) ())))) '((#:compile-concatenated-source-op (#:operation) ()))))
(loop :for name :in redefined-functions (loop :for name :in redefined-functions
:for sym = (find-symbol* name :asdf nil) :do :for sym = (find-symbol* name :asdf nil) :do
(when sym (when sym
......
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