Commit ab797258 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.26.162: improve the upgrade cleanup mechanism

Make it run even if ASDF wasn't upgraded via upgrade-asdf.
parent 64b4399e
...@@ -62,7 +62,7 @@ ...@@ -62,7 +62,7 @@
:licence "MIT" :licence "MIT"
:description "Another System Definition Facility" :description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems." :long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.26.161" ;; to be automatically updated by make bump-version :version "2.26.162" ;; to be automatically updated by make bump-version
:depends-on () :depends-on ()
#+asdf3 :encoding #+asdf3 :utf-8 #+asdf3 :encoding #+asdf3 :utf-8
;; For most purposes, asdf itself specially counts as a builtin system. ;; For most purposes, asdf itself specially counts as a builtin system.
......
...@@ -69,7 +69,7 @@ ...@@ -69,7 +69,7 @@
:when (eq feature? 'feature) :do :when (eq feature? 'feature) :do
(setf (component-if-feature c) feature))))) (setf (component-if-feature c) feature)))))
(when-upgrade (:when (fboundp 'make-sub-operation)) (when-upgrading (:when (fboundp 'make-sub-operation))
(defun* make-sub-operation (c o dep-c dep-o) (defun* make-sub-operation (c o dep-c dep-o)
(declare (ignore c o dep-c dep-o)) (asdf-upgrade-error))) (declare (ignore c o dep-c dep-o)) (asdf-upgrade-error)))
......
...@@ -57,7 +57,7 @@ another pathname in a degenerate way.")) ...@@ -57,7 +57,7 @@ another pathname in a degenerate way."))
;;; TODO: find users, have them stop using that. ;;; TODO: find users, have them stop using that.
(defgeneric* (source-file-type) (component system)) (defgeneric* (source-file-type) (component system))
(when-upgrade (:when (find-class 'component nil)) (when-upgrading (:when (find-class 'component nil))
(defmethod reinitialize-instance :after ((c component) &rest initargs &key) (defmethod reinitialize-instance :after ((c component) &rest initargs &key)
(declare (ignorable c initargs)) (values))) (declare (ignorable c initargs)) (values)))
...@@ -168,7 +168,7 @@ another pathname in a degenerate way.")) ...@@ -168,7 +168,7 @@ another pathname in a degenerate way."))
(setf (gethash name hash) c)) (setf (gethash name hash) c))
hash)))) hash))))
(when-upgrade (:when (find-class 'module nil)) (when-upgrading (:when (find-class 'module nil))
(defmethod reinitialize-instance :after ((m module) &rest initargs &key) (defmethod reinitialize-instance :after ((m module) &rest initargs &key)
(declare (ignorable m initargs)) (values)) (declare (ignorable m initargs)) (values))
(defmethod update-instance-for-redefined-class :after (defmethod update-instance-for-redefined-class :after
......
...@@ -15,7 +15,7 @@ ...@@ -15,7 +15,7 @@
#:report-invalid-form #:invalid-configuration #:*ignored-configuration-form* #:report-invalid-form #:invalid-configuration #:*ignored-configuration-form*
#:*clear-configuration-hook* #:clear-configuration #:register-clear-configuration-hook #:*clear-configuration-hook* #:clear-configuration #:register-clear-configuration-hook
#:resolve-location #:location-designator-p #:location-function-p #:*here-directory* #:resolve-location #:location-designator-p #:location-function-p #:*here-directory*
#:resolve-relative-location #:resolve-absolute-location)) #:resolve-relative-location #:resolve-absolute-location #:upgrade-configuration))
(in-package :asdf/configuration) (in-package :asdf/configuration)
(define-condition invalid-configuration () (define-condition invalid-configuration ()
...@@ -286,3 +286,11 @@ directive.") ...@@ -286,3 +286,11 @@ directive.")
(call-functions *clear-configuration-hook*)) (call-functions *clear-configuration-hook*))
(register-image-dump-hook 'clear-configuration) (register-image-dump-hook 'clear-configuration)
;; If a previous version of ASDF failed to read some configuration, try again.
(defun* upgrade-configuration ()
(when *ignored-configuration-form*
(clear-configuration)
(setf *ignored-configuration-form* nil)))
...@@ -56,16 +56,18 @@ ...@@ -56,16 +56,18 @@
(error 'formatted-system-definition-error :format-control (error 'formatted-system-definition-error :format-control
format :format-arguments arguments)) format :format-arguments arguments))
(defun* make-defined-systems-table () (defvar *defined-systems* (make-hash-table :test 'equal)
(make-hash-table :test 'equal))
(defvar *defined-systems* (make-defined-systems-table)
"This is a hash table whose keys are strings, being the "This is a hash table whose keys are strings, being the
names of the systems, and whose values are pairs, the first names of the systems, and whose values are pairs, the first
element of which is a universal-time indicating when the element of which is a universal-time indicating when the
system definition was last updated, and the second element system definition was last updated, and the second element
of which is a system object.") of which is a system object.")
(defun* clear-defined-systems ()
(setf *defined-systems* (make-hash-table :test 'equal)))
(register-hook-function '*post-upgrade-cleanup-hook* 'clear-defined-systems nil)
(defun* coerce-name (name) (defun* coerce-name (name)
(typecase name (typecase name
(component (component-name name)) (component (component-name name))
......
...@@ -40,15 +40,6 @@ ...@@ -40,15 +40,6 @@
(values-list l)))))) (values-list l))))))
;;;; Cleanups after hot-upgrade.
;; Things to do in case we're upgrading from a previous version of ASDF.
;; See https://bugs.launchpad.net/asdf/+bug/485687
;;
;; If a previous version of ASDF failed to read some configuration, try again.
(when *ignored-configuration-form*
(clear-configuration)
(setf *ignored-configuration-form* nil))
;;;; Done! ;;;; Done!
#+allegro #+allegro
...@@ -60,6 +51,9 @@ ...@@ -60,6 +51,9 @@
(provide :asdf) (provide :asdf)
;;;; Cleanups after hot-upgrade.
(cleanup-upgraded-asdf)
(when *load-verbose* (when *load-verbose*
(asdf-message ";; ASDF, version ~a~%" (asdf-version))) (asdf-message ";; ASDF, version ~a~%" (asdf-version)))
......
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.26.161: Another System Definition Facility. ;;; This is ASDF 2.26.162: Another System Definition Facility.
;;; ;;;
;;; Feedback, bug reports, and patches are all welcome: ;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>. ;;; please mail to <asdf-devel@common-lisp.net>.
......
...@@ -157,14 +157,6 @@ for how to load or compile stuff") ...@@ -157,14 +157,6 @@ for how to load or compile stuff")
;;;; Some upgrade magic ;;;; Some upgrade magic
(defun* reset-asdf-systems ()
(let ((asdf (find-system :asdf)))
(setf (component-version asdf) (asdf-version))
;; Invalidate all systems but ASDF itself.
(setf *defined-systems* (make-defined-systems-table))
(register-system asdf)
(load-system asdf))) ;; re-load ourselves the right way
(defun* restart-upgraded-asdf () (defun* restart-upgraded-asdf ()
;; If we're in the middle of something, restart it. ;; If we're in the middle of something, restart it.
(when *systems-being-defined* (when *systems-being-defined*
...@@ -172,5 +164,4 @@ for how to load or compile stuff") ...@@ -172,5 +164,4 @@ for how to load or compile stuff")
(clrhash *systems-being-defined*) (clrhash *systems-being-defined*)
(dolist (s l) (find-system s nil))))) (dolist (s l) (find-system s nil)))))
(pushnew 'reset-asdf-systems *post-upgrade-cleanup-hook*)
(pushnew 'restart-upgraded-asdf *post-upgrade-restart-hook*) (pushnew 'restart-upgraded-asdf *post-upgrade-restart-hook*)
...@@ -15,7 +15,7 @@ ...@@ -15,7 +15,7 @@
;;; Operation Classes ;;; Operation Classes
(when-upgrade (:when (find-class 'operation nil)) (when-upgrading (:when (find-class 'operation nil))
(defmethod shared-initialize :after ((o operation) slot-names &rest initargs &key) (defmethod shared-initialize :after ((o operation) slot-names &rest initargs &key)
(declare (ignorable o slot-names initargs)) (values))) (declare (ignorable o slot-names initargs)) (values)))
......
...@@ -22,7 +22,7 @@ ...@@ -22,7 +22,7 @@
)) ))
(in-package :asdf/output-translations) (in-package :asdf/output-translations)
(when-upgrade () (undefine-function '(setf output-translations))) (when-upgrading () (undefine-function '(setf output-translations)))
(define-condition invalid-output-translation (invalid-configuration warning) (define-condition invalid-output-translation (invalid-configuration warning)
((format :initform (compatfmt "~@<Invalid asdf output-translation ~S~@[ in ~S~]~@{ ~@?~}~@:>")))) ((format :initform (compatfmt "~@<Invalid asdf output-translation ~S~@[ in ~S~]~@{ ~@?~}~@:>"))))
......
This diff is collapsed.
...@@ -308,7 +308,7 @@ instead of a list." ...@@ -308,7 +308,7 @@ instead of a list."
(defun* call-functions (function-specs) (defun* call-functions (function-specs)
(map () 'call-function function-specs)) (map () 'call-function function-specs))
(defun* register-hook-function (variable hook &optional (call-now-p t)) (defun* register-hook-function (variable hook &optional call-now-p)
(pushnew hook (symbol-value variable)) (pushnew hook (symbol-value variable))
(when call-now-p (call-function hook))) (when call-now-p (call-function hook)))
...@@ -372,8 +372,8 @@ with later being determined by a lexicographical comparison of minor numbers." ...@@ -372,8 +372,8 @@ with later being determined by a lexicographical comparison of minor numbers."
#+allegro 'excl::format-control #+allegro 'excl::format-control
#+clisp 'system::$format-control #+clisp 'system::$format-control
#+clozure 'ccl::format-control #+clozure 'ccl::format-control
#+ecl 'si::format-control
#+(or cmu scl) 'conditions::format-control #+(or cmu scl) 'conditions::format-control
#+ecl 'si::format-control
#+(or gcl lispworks) 'conditions::format-string #+(or gcl lispworks) 'conditions::format-string
#+sbcl 'sb-kernel:format-control #+sbcl 'sb-kernel:format-control
#-(or abcl allegro clisp clozure cmu ecl gcl lispworks sbcl scl) nil #-(or abcl allegro clisp clozure cmu ecl gcl lispworks sbcl scl) nil
......
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