Skip to content
Snippets Groups Projects
Commit db6a7b33 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Have softer upgrades when upgrading from a forward-compatible-enough version.

NB: insufficiently tested.
parent 7bb84d2e
No related branches found
No related tags found
No related merge requests found
......@@ -16,7 +16,7 @@
;;;; Backward compatibility with "inline methods"
(with-upgradability ()
(defparameter +asdf-methods+
(defparameter* +asdf-methods+
'(perform-with-restarts perform explain output-files operation-done-p))
(defun %remove-component-inline-methods (component)
......
......@@ -36,7 +36,8 @@
;;; make-operation, find-operation
(with-upgradability ()
(defparameter *operations* (make-hash-table :test 'equal))
(defparameter* *operations* (make-hash-table :test 'equal))
(defun make-operation (operation-class &rest initargs)
(ensure-gethash (cons operation-class initargs) *operations*
(list* 'make-instance operation-class initargs)))
......
......@@ -128,7 +128,7 @@ and the order is by decreasing length of namestring of the source pathname.")
(push :ignore-inherited-configuration directives))
(return `(:output-translations ,@(nreverse directives)))))))))
(defparameter *default-output-translations*
(defparameter* *default-output-translations*
'(environment-output-translations
user-output-translations-pathname
user-output-translations-directory-pathname
......
......@@ -141,7 +141,7 @@ system names to pathnames of .asd files")
(collect-sub*directories-asd-files
directory :exclude exclude :collect collect)))
(defparameter *default-source-registries*
(defparameter* *default-source-registries*
'(environment-source-registry
user-source-registry
user-source-registry-directory
......
......@@ -8,7 +8,7 @@
(:export
#:asdf-version #:*previous-asdf-versions* #:*asdf-version*
#:asdf-message #:*verbose-out*
#:upgrading-p #:when-upgrading #:upgrade-asdf #:asdf-upgrade-error
#:upgrading-p #:when-upgrading #:upgrade-asdf #:asdf-upgrade-error #:defparameter*
#:*post-upgrade-cleanup-hook* #:*post-upgrade-restart-hook* #:cleanup-upgraded-asdf
;; There will be no symbol left behind!
#:intern*)
......@@ -29,8 +29,20 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
(string rev)
(cons (format nil "~{~D~^.~}" rev))
(null "1.0"))))))
;; Important: define *p-a-v* /before/ *a-v* so that it initializes correctly.
(defvar *previous-asdf-versions* (if-let (previous (asdf-version)) (list previous)))
(defvar *asdf-version* nil)
(defvar *previous-asdf-versions* nil)
;; We need to clear systems from versions yet older than the below:
(defparameter *oldest-forward-compatible-asdf-version* "2.27")
(defmacro defparameter* (var value &optional docstring)
(let* ((name (string-trim "*" var))
(valfun (intern (format nil "%~A-~A-~A" :compute name :value)))
(clearfun (intern (format nil "%~A-~A" :clear name))))
`(progn
(defun ,valfun () ,value)
(defvar ,var (,valfun) ,@(ensure-list docstring))
(defun ,clearfun () (setf ,var (,valfun)))
(register-hook-function '*post-upgrade-cleanup-hook* ',clearfun))))
(defvar *verbose-out* nil)
(defun asdf-message (format-string &rest format-args)
(when *verbose-out* (apply 'format *verbose-out* format-string format-args)))
......@@ -126,7 +138,12 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
old-version new-version)
(asdf-message (compatfmt "~&~@<; ~@;Upgraded ASDF from version ~A to version ~A~@:>~%")
old-version new-version))
(call-functions (reverse *post-upgrade-cleanup-hook*))
;; In case the previous version was too old to be forward-compatible, clear systems.
;; TODO: if needed, we may have to define a separate hook to run
;; in case of forward-compatible upgrade.
;; Or to move the tests forward-compatibility test inside each hook function?
(unless (version<= *oldest-forward-compatible-asdf-version* old-version)
(call-functions (reverse *post-upgrade-cleanup-hook*)))
t))))
(defun upgrade-asdf ()
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment