diff --git a/backward-internals.lisp b/backward-internals.lisp index 0ecb7dd5e5583e21df730c99be7f74393a1976f1..07e39c6a02ea344fac678dc83629429221f79bf0 100644 --- a/backward-internals.lisp +++ b/backward-internals.lisp @@ -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) diff --git a/operation.lisp b/operation.lisp index 16ac48756a096f79f189dc5fc9010a160f84107b..7f18c45a4b8b687db157114f67364a67dd37e32d 100644 --- a/operation.lisp +++ b/operation.lisp @@ -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))) diff --git a/output-translations.lisp b/output-translations.lisp index 6905cf5bc4d0dfc731706ee8dc749d6b24b7d66a..265876556bc0fb3b3428d92e425a12f781d477b5 100644 --- a/output-translations.lisp +++ b/output-translations.lisp @@ -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 diff --git a/source-registry.lisp b/source-registry.lisp index a558ed1fd2ce8e0102214b59c085e4e53b55b502..cd7ab5ae19a61296a9e0750ef34cae0bc3b59857 100644 --- a/source-registry.lisp +++ b/source-registry.lisp @@ -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 diff --git a/upgrade.lisp b/upgrade.lisp index 14a03fe2c8fd947c1f7132c8ede9008c00761299..3b7d9044d7b45aa5b7b3f96158be37140d52d9c0 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -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 ()