diff --git a/asdf.asd b/asdf.asd index 00bb62535b9f016946487d775ddae2411a8ce0d9..0e27701b8ed8f78f5af6003f9b077bce13f095e6 100644 --- a/asdf.asd +++ b/asdf.asd @@ -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. diff --git a/backward-internals.lisp b/backward-internals.lisp index 6caf4d2a8b58f5b0c2386637904cd953cd858e06..cd56b47141e1dbd32647c7bdea4f971f3589ab78 100644 --- a/backward-internals.lisp +++ b/backward-internals.lisp @@ -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))) diff --git a/component.lisp b/component.lisp index 3e8c7fd4e9ab7e0d37265adccbdc17b1a1088f32..81b1755d15819a261fc914814fd178ac66914556 100644 --- a/component.lisp +++ b/component.lisp @@ -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 diff --git a/configuration.lisp b/configuration.lisp index 59b6ff9f02b89d5a0e6f768ded17ae69fce47c2d..8ffc6a71e3142c14a230dc7c5081dc45d609a95f 100644 --- a/configuration.lisp +++ b/configuration.lisp @@ -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))) + + diff --git a/find-system.lisp b/find-system.lisp index d8ee29d8fb506c1ad240caafbcd1de74fcd281b7..81cdc8f8b7e33366f6b94753221a6c7dc1908d8e 100644 --- a/find-system.lisp +++ b/find-system.lisp @@ -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)) diff --git a/footer.lisp b/footer.lisp index 173dd1ba6dfefc71da9d705ba325fefd032ccaae..9c8f0c25ff6e8a45fe0a3576627ebd5d1d8902cb 100644 --- a/footer.lisp +++ b/footer.lisp @@ -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))) diff --git a/header.lisp b/header.lisp index 24854d236d2310e91a91ab39f98ee8dd8fd1ada8..90cfafeba0f20546ea63a306d441183a747b1099 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;;; -*- 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>. diff --git a/operate.lisp b/operate.lisp index 0420b226d3ff70199c08d62a2c352e52829b2fc8..37924c8565529df3111d64b5e338f73ee5bf3d5e 100644 --- a/operate.lisp +++ b/operate.lisp @@ -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*) diff --git a/operation.lisp b/operation.lisp index 53296c53e333366d5c878eb92f3cda5d79fc619d..c8513ce07cb343217fc8d48c0f8bdab4ba20b61d 100644 --- a/operation.lisp +++ b/operation.lisp @@ -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))) diff --git a/output-translations.lisp b/output-translations.lisp index ac6dcc8ef182e1552af1946c02a0414976cbac6a..59e6a2cd828954a9944478a23179f561295a876c 100644 --- a/output-translations.lisp +++ b/output-translations.lisp @@ -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~]~@{ ~@?~}~@:>")))) diff --git a/upgrade.lisp b/upgrade.lisp index 898466658ac46531b9592980178826d365ea08c7..d679faa18482020826aaf96aa4b6264345cb79b1 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -4,13 +4,12 @@ (asdf/package:define-package :asdf/upgrade (:recycle :asdf/upgrade :asdf) - (:use :asdf/common-lisp :asdf/package :asdf/utility) + (:use :asdf/common-lisp :asdf/driver) (:export - #:upgrade-asdf #:asdf-upgrade-error #:when-upgrade - #:*asdf-upgrade-already-attempted* - #:*post-upgrade-cleanup-hook* #:*post-upgrade-restart-hook* #:cleanup-upgraded-asdf - #:asdf-version #:*upgraded-p* #:*asdf-version* + #:asdf-version #:*previous-asdf-versions* #:*asdf-version* #:asdf-message #:*asdf-verbose* #:*verbose-out* + #:upgrading-p #:when-upgrading #:upgrade-asdf #:asdf-upgrade-error + #:*post-upgrade-cleanup-hook* #:*post-upgrade-restart-hook* #:cleanup-upgraded-asdf ;; There will be no symbol left behind! #:intern*) (:import-from :asdf/package #:intern* #:find-symbol*)) @@ -19,30 +18,57 @@ ;;; Special magic to detect if this is an upgrade (eval-when (:load-toplevel :compile-toplevel :execute) + (defun asdf-version () + "Exported interface to the version of ASDF currently installed. A string. +You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSION) \"3.4.5.67\")." + (when (find-package :asdf) + (or (symbol-value (find-symbol (string :*asdf-version*) :asdf)) + (let ((ver (symbol-value (find-symbol (string :*asdf-revision*) :asdf)))) + (etypecase ver + (string ver) + (cons (format nil "~{~D~^.~}" ver)) + (null "1.0")))))) (defvar *asdf-version* nil) - (defvar *upgraded-p* nil) + (defvar *previous-asdf-versions* nil) (defvar *asdf-verbose* nil) ; was t from 2.000 to 2.014.12. (defvar *verbose-out* nil) (defun* asdf-message (format-string &rest format-args) - (apply 'format *verbose-out* format-string format-args))) + (apply 'format *verbose-out* format-string format-args)) + (defvar *post-upgrade-cleanup-hook* ()) + (defvar *post-upgrade-restart-hook* ()) + (defun* upgrading-p () + (and *previous-asdf-versions* (not (equal *asdf-version* (first *previous-asdf-versions*))))) + (defmacro when-upgrading ((&key (upgrading-p '(upgrading-p)) when) &body body) + `(eval-when (:compile-toplevel :load-toplevel :execute) + (when (and ,upgrading-p ,@(when when `(,when))) + (handler-bind ((style-warning #'muffle-warning)) + (eval '(progn ,@body))))))) (eval-when (:load-toplevel :compile-toplevel :execute) (let* (;; For bug reporting sanity, please always bump this version when you modify this file. - ;; Please also modify asdf.asd to reflect this change. make bump-version + ;; Please also modify asdf.asd to reflect this change. make bump-version v=3.4.5.67.8 ;; can help you do these changes in synch (look at the source for documentation). ;; Relying on its automation, the version is now redundantly present on top of this file. - ;; "2.345" would be an official release - ;; "2.345.6" would be a development version in the official upstream - ;; "2.345.0.7" would be your seventh local modification of official release 2.345 - ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6 - (asdf-version "2.26.161") - (existing-asdf (find-class (find-symbol* :component :asdf nil) nil)) - (existing-version *asdf-version*) - (already-there (equal asdf-version existing-version)) - (redefined-functions ;; gf signature and/or semantics changed incompatibly. Oops. - '(#:component-relative-pathname #:component-parent-pathname ;; component - #:source-file-type - #:find-system #:system-source-file #:system-relative-pathname ;; system + ;; "3.4" would be the general branch for major version 3, minor version 4. + ;; "3.4.5" would be an official release in the 3.4 branch. + ;; "3.4.5.67" would be a development version in the official upstream of 3.4.5. + ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5 + ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67 + (asdf-version "2.26.162") + (existing-version (asdf-version))) + (when (and existing-version (not (equal asdf-version existing-version))) + (push existing-version *previous-asdf-versions*) + (when *asdf-verbose* + (format *trace-output* + (compatfmt "~&~@<; ~@;Upgrading ASDF ~@[from version ~A ~]to version ~A~@:>~%") + existing-version asdf-version))) + (setf *asdf-version* asdf-version))) + +(when-upgrading () + (let ((redefined-functions ;; gf signature and/or semantics changed incompatibly. Oops. + '(#:component-relative-pathname #:component-parent-pathname ;; component + #:source-file-type + #:find-system #:system-source-file #:system-relative-pathname ;; system #:find-component ;; find-component #:explain #:perform #:perform-with-restarts #:input-files #:output-files ;; action #:component-depends-on #:component-self-dependencies #:operation-done-p @@ -51,7 +77,7 @@ #:apply-output-translations ;; output-translations #:process-output-translations-directive #:inherit-source-registry #:process-source-registry ;; source-registry - #:process-source-registry-directive + #:process-source-registry-directive #:trivial-system-p ;; bundle ;; NB: it's too late to do anything about asdf-driver functions! )) @@ -61,93 +87,57 @@ #:resolve-relative-location-component #:resolve-absolute-location-component #:output-files-for-system-and-operation))) ; obsolete ASDF-BINARY-LOCATION function (declare (ignorable redefined-functions uninterned-symbols)) - (setf *asdf-version* asdf-version) - (when (and existing-asdf (not already-there)) - (push existing-version *upgraded-p*) - (when *asdf-verbose* - (format *trace-output* - (compatfmt "~&~@<; ~@;Upgrading ASDF ~@[from version ~A ~]to version ~A~@:>~%") - existing-version asdf-version)) - (loop :for name :in (append #-(or clisp ecl) redefined-functions) - :for sym = (find-symbol* name :asdf nil) :do - (when sym - ;;(format t "Undefining ~S~%" sym);XXX - (fmakunbound sym))) - (loop :with asdf = (find-package :asdf) - :for name :in (append #+(or clisp ecl) redefined-functions uninterned-symbols) ;XXX - :for sym = (find-symbol* name :asdf nil) - :for base-pkg = (and sym (symbol-package sym)) :do - (when sym - ;;(format t "frobbing symbol ~S~%" sym);XXX - (cond - ((or (eq base-pkg asdf) (not base-pkg)) - (unintern* sym asdf) - (intern* sym asdf)) - (t - (unintern* sym base-pkg) - (let ((new (intern* sym base-pkg))) - (shadowing-import new asdf)))))) - ;; Note that this massive package destruction makes it impossible - ;; to use asdf/driver on top of an old ASDF on these implementations - #+(or xcl) - (let ((p (find-package :asdf))) - (when p - (do-symbols (s p) (when (home-package-p s p) (nuke-symbol s))) - (rename-package-away p :prefix (format nil "~A-~A" :asdf (or existing-version :1.x)) - :index 0 :separator "-")))))) + (loop :for name :in (append #-(or clisp ecl) redefined-functions) + :for sym = (find-symbol* name :asdf nil) :do + (when sym + (fmakunbound sym))) + (loop :with asdf = (find-package :asdf) + :for name :in (append #+(or clisp ecl) redefined-functions uninterned-symbols) ;XXX + :for sym = (find-symbol* name :asdf nil) + :for base-pkg = (and sym (symbol-package sym)) :do + (when sym + (cond + ((or (eq base-pkg asdf) (not base-pkg)) + (unintern* sym asdf) + (intern* sym asdf)) + (t + (unintern* sym base-pkg) + (let ((new (intern* sym base-pkg))) + (shadowing-import new asdf)))))))) -;;; Upgrade interface +;;; Self-upgrade functions (defun* asdf-upgrade-error () ;; Important notice for whom it concerns. The crux of the matter is that ;; TRAVERSE can be completely refactored, and so after the find-system returns, it's too late. (error "When a system transitively depends on ASDF, it must :defsystem-depends-on (:asdf)~%~ - Otherwise, when you upgrade ASDF, you must do it before you operate on any system.~%")) - -(defmacro when-upgrade ((&key (upgraded-p '*upgraded-p*) when) &body body) - `(eval-when (:compile-toplevel :load-toplevel :execute) - (when (and ,upgraded-p ,@(when when `(,when))) - (handler-bind ((style-warning #'muffle-warning)) - (eval '(progn ,@body)))))) - -(defun* asdf-version () - "Exported interface to the version of ASDF currently installed. A string. -You can compare this string with e.g.: -(ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSION) \"2.345.67\")." - *asdf-version*) - + Otherwise, when you upgrade from ASDF 2, you must do it before you operate on any system.~%")) -;;; Self-upgrade functions - -(defvar *post-upgrade-cleanup-hook* ()) -(defvar *post-upgrade-restart-hook* ()) - -(defun* cleanup-upgraded-asdf (old-version) +(defun* cleanup-upgraded-asdf (&optional (old-version (first *previous-asdf-versions*))) (let ((new-version (asdf-version))) (unless (equal old-version new-version) - (cond - ((version-compatible-p new-version old-version) - (asdf-message (compatfmt "~&~@<; ~@;Upgraded ASDF from version ~A to version ~A~@:>~%") - old-version new-version)) - ((version-compatible-p old-version new-version) - (warn (compatfmt "~&~@<; ~@;Downgraded ASDF from version ~A to version ~A~@:>~%") - old-version new-version)) - (t - (asdf-message (compatfmt "~&~@<; ~@;Changed ASDF from version ~A to incompatible version ~A~@:>~%") - old-version new-version))) - (dolist (h (reverse *post-upgrade-cleanup-hook*)) - (funcall (ensure-function h))) - (dolist (h *post-upgrade-restart-hook*) - (funcall (ensure-function h))) - t))) + (push new-version *previous-asdf-versions*) + (when old-version + (cond + ((version-compatible-p new-version old-version) + (asdf-message (compatfmt "~&~@<; ~@;Upgraded ASDF from version ~A to version ~A~@:>~%") + old-version new-version)) + ((version-compatible-p old-version new-version) + (warn (compatfmt "~&~@<; ~@;Downgraded ASDF from version ~A to version ~A~@:>~%") + old-version new-version)) + (t + (asdf-message (compatfmt "~&~@<; ~@;Changed ASDF from version ~A to incompatible version ~A~@:>~%") + old-version new-version))) + (call-functions (reverse *post-upgrade-cleanup-hook*)) + t)))) (defun* upgrade-asdf () "Try to upgrade of ASDF. If a different version was used, return T. We need do that before we operate on anything that may possibly depend on ASDF." - (let ((version (asdf-version)) - (*load-print* nil) + (let ((*load-print* nil) (*compile-print* nil)) (handler-bind (((or style-warning warning) #'muffle-warning)) - (symbol-call :asdf :load-system :asdf :verbose nil)) - (cleanup-upgraded-asdf version))) + (symbol-call :asdf :load-system :asdf :verbose nil)))) + +(register-hook-function '*post-upgrade-cleanup-hook* 'upgrade-configuration) diff --git a/utility.lisp b/utility.lisp index af9c8dee5df6a4864e84c5ba250ec90b90889978..9ab5415cce768e78a06c0d1b51306a2dba22eab9 100644 --- a/utility.lisp +++ b/utility.lisp @@ -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 diff --git a/version.lisp-expr b/version.lisp-expr index 16d8e942ee2701fba4b44ee456c4ef5b218032ac..225257404089a9123475586360e5b8535f2de67d 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1 +1 @@ -"2.26.161" +"2.26.162"