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 @@
:licence "MIT"
:description "Another System Definition Facility"
: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 ()
#+asdf3 :encoding #+asdf3 :utf-8
;; For most purposes, asdf itself specially counts as a builtin system.
......
......@@ -69,7 +69,7 @@
:when (eq feature? 'feature) :do
(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)
(declare (ignore c o dep-c dep-o)) (asdf-upgrade-error)))
......
......@@ -57,7 +57,7 @@ another pathname in a degenerate way."))
;;; TODO: find users, have them stop using that.
(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)
(declare (ignorable c initargs)) (values)))
......@@ -168,7 +168,7 @@ another pathname in a degenerate way."))
(setf (gethash name hash) c))
hash))))
(when-upgrade (:when (find-class 'module nil))
(when-upgrading (:when (find-class 'module nil))
(defmethod reinitialize-instance :after ((m module) &rest initargs &key)
(declare (ignorable m initargs)) (values))
(defmethod update-instance-for-redefined-class :after
......
......@@ -15,7 +15,7 @@
#:report-invalid-form #:invalid-configuration #:*ignored-configuration-form*
#:*clear-configuration-hook* #:clear-configuration #:register-clear-configuration-hook
#: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)
(define-condition invalid-configuration ()
......@@ -286,3 +286,11 @@ directive.")
(call-functions *clear-configuration-hook*))
(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 @@
(error 'formatted-system-definition-error :format-control
format :format-arguments arguments))
(defun* make-defined-systems-table ()
(make-hash-table :test 'equal))
(defvar *defined-systems* (make-defined-systems-table)
(defvar *defined-systems* (make-hash-table :test 'equal)
"This is a hash table whose keys are strings, being the
names of the systems, and whose values are pairs, the first
element of which is a universal-time indicating when the
system definition was last updated, and the second element
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)
(typecase name
(component (component-name name))
......
......@@ -40,15 +40,6 @@
(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!
#+allegro
......@@ -60,6 +51,9 @@
(provide :asdf)
;;;; Cleanups after hot-upgrade.
(cleanup-upgraded-asdf)
(when *load-verbose*
(asdf-message ";; ASDF, version ~a~%" (asdf-version)))
......
;;; -*- 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:
;;; please mail to <asdf-devel@common-lisp.net>.
......
......@@ -157,14 +157,6 @@ for how to load or compile stuff")
;;;; 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 ()
;; If we're in the middle of something, restart it.
(when *systems-being-defined*
......@@ -172,5 +164,4 @@ for how to load or compile stuff")
(clrhash *systems-being-defined*)
(dolist (s l) (find-system s nil)))))
(pushnew 'reset-asdf-systems *post-upgrade-cleanup-hook*)
(pushnew 'restart-upgraded-asdf *post-upgrade-restart-hook*)
......@@ -15,7 +15,7 @@
;;; 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)
(declare (ignorable o slot-names initargs)) (values)))
......
......@@ -22,7 +22,7 @@
))
(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)
((format :initform (compatfmt "~@<Invalid asdf output-translation ~S~@[ in ~S~]~@{ ~@?~}~@:>"))))
......
This diff is collapsed.
......@@ -308,7 +308,7 @@ instead of a list."
(defun* call-functions (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))
(when call-now-p (call-function hook)))
......@@ -372,8 +372,8 @@ with later being determined by a lexicographical comparison of minor numbers."
#+allegro 'excl::format-control
#+clisp 'system::$format-control
#+clozure 'ccl::format-control
#+ecl 'si::format-control
#+(or cmu scl) 'conditions::format-control
#+ecl 'si::format-control
#+(or gcl lispworks) 'conditions::format-string
#+sbcl 'sb-kernel:format-control
#-(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