Commit 18c47d2f authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.30.4: be more clever wrt refusing to downgrading ASDF.

Also restore lost (setf (gethash name *systems-being-defined*) system)
in register-system-definition.
parent 77640721
......@@ -74,7 +74,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.30.3" ;; to be automatically updated by make bump-version
:version "2.30.4" ;; 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.
......
......@@ -192,8 +192,8 @@
(let ((pv (parse-version v 'error)))
(assert (first pv))
(assert (second pv))
(unless (third pv) (appendf pv '(0)))
(incf (third pv))
(unless (third pv) (appendf pv (list 0)))
(incf (car (last pv)))
(unparse-version pv)))
(defun version-from-file ()
......
......@@ -192,6 +192,7 @@
(component-options (remove-plist-key :class options))
(defsystem-dependencies (loop :for spec :in defsystem-depends-on :collect
(resolve-dependency-spec nil spec))))
(setf (gethash name *systems-being-defined*) system)
(apply 'load-systems defsystem-dependencies)
;; We change-class AFTER we loaded the defsystem-depends-on
;; since the class might be defined as part of those.
......
......@@ -232,6 +232,20 @@ Going forward, we recommend new users should be using the source-registry.
(list new)
(subseq *central-registry* (1+ position))))))))))
(defvar *preloaded-systems* (make-hash-table :test 'equal))
(defun sysdef-preloaded-system-search (requested)
(let ((name (coerce-name requested)))
(multiple-value-bind (keys foundp) (gethash name *preloaded-systems*)
(when foundp
(apply 'make-instance 'system :name name :source-file (getf keys :source-file) keys)))))
(defun register-preloaded-system (system-name &rest keys)
(setf (gethash (coerce-name system-name) *preloaded-systems*) keys))
(register-preloaded-system "asdf" :version *asdf-version*)
(register-preloaded-system "asdf-driver" :version *asdf-version*)
(defmethod find-system ((name null) &optional (error-p t))
(declare (ignorable name))
(when error-p
......@@ -281,6 +295,47 @@ Going forward, we recommend new users should be using the source-registry.
(with-muffled-loader-conditions ()
(load* pathname :external-format external-format)))))))
(defvar *old-asdf-systems* (make-hash-table :test 'equal))
(defun check-not-old-asdf-system (name pathname)
(or (not (equal name "asdf"))
(null pathname)
(let* ((version-pathname (subpathname pathname "version.lisp-expr"))
(version (and (probe-file* version-pathname :truename nil)
(read-file-form version-pathname)))
(old-version (asdf-version)))
(or (version<= old-version version)
(let ((old-pathname
(if-let (pair (system-registered-p "asdf"))
(system-source-file (cdr pair))))
(key (list pathname old-version)))
(format t "~S~%" (list :cnoas name pathname version-pathname version old-pathname old-version key (gethash key *old-asdf-systems*)))
(unless (gethash key *old-asdf-systems*)
(setf (gethash key *old-asdf-systems*) t)
(warn "~@<~
You are using ASDF version ~A ~:[(probably from (require \"asdf\") ~
or loaded by quicklisp)~;from ~:*~S~] and have an older version of ASDF ~
~:[(and older than 2.27 at that)~;~:*~A~] registered at ~S. ~
Having an ASDF installed and registered is the normal way of configuring ASDF to upgrade itself, ~
and having an old version registered is a configuration error. ~
ASDF will ignore this configured system rather than downgrade itself. ~
In the future, you may want to either: ~
(a) upgrade this configured ASDF to a newer version, ~
(b) install a newer ASDF and register it in front of the former in your configuration, or ~
(c) uninstall or unregister this and any other old version of ASDF from your configuration. ~
Note that the older ASDF might be registered implicitly through configuration inherited ~
from your system installation, in which case you might have to specify ~
:ignore-inherited-configuration in your in your ~~/.config/common-lisp/source-registry.conf ~
or other source-registry configuration file, environment variable or lisp parameter. ~
Indeed, a likely offender is an obsolete version of the cl-asdf debian or ubuntu package, ~
that you might want to upgrade (if a recent enough version is available) ~
or else remove altogether (since most implementations ship with a recent asdf); ~
if you lack the system administration rights to upgrade or remove this package, ~
then you might indeed want to either install and register a more recent version, ~
or use :ignore-inherited-configuration to avoid registering the old one. ~
Please consult ASDF documentation and/or experts.~@:>~%"
old-version old-pathname version pathname)))))))
(defun locate-system (name)
"Given a system NAME designator, try to locate where to load the system from.
Returns five values: FOUNDP FOUND-SYSTEM PATHNAME PREVIOUS PREVIOUS-TIME
......@@ -298,12 +353,20 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(previous-time (car in-memory))
(found (search-for-system-definition name))
(found-system (and (typep found 'system) found))
(pathname (or (and (typep found '(or pathname string)) (pathname found))
(and found-system (system-source-file found-system))
(and previous (system-source-file previous))))
(pathname (ensure-pathname (resolve-symlinks* pathname) :want-absolute t))
(pathname (ensure-pathname
(or (and (typep found '(or pathname string)) (pathname found))
(and found-system (system-source-file found-system))
(and previous (system-source-file previous)))
:want-absolute t :resolve-symlinks *resolve-symlinks*))
(foundp (and (or found-system pathname previous) t)))
(check-type found (or null pathname system))
(unless (check-not-old-asdf-system name pathname)
(cond
(previous (setf found nil pathname nil))
(t
(setf found (sysdef-preloaded-system-search "asdf"))
(assert (typep found 'system))
(setf found-system found pathname nil))))
(values foundp found-system pathname previous previous-time)))
(defmethod find-system ((name string) &optional (error-p t))
......@@ -329,7 +392,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(translate-logical-pathname pathname)
(translate-logical-pathname previous-pathname))))
(stamp<= stamp previous-time))))))
;; only load when it's a pathname that is different or has newer content
;; only load when it's a pathname that is different or has newer content, and not an old asdf
(load-asd pathname :name name)))
(let ((in-memory (system-registered-p name))) ; try again after loading from disk if needed
(return
......@@ -343,19 +406,5 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(reinitialize-source-registry-and-retry ()
:report (lambda (s)
(format s (compatfmt "~@<Retry finding system ~A after reinitializing the source-registry.~@:>") name))
(initialize-source-registry))))))
(defvar *preloaded-systems* (make-hash-table :test 'equal))
(defun sysdef-preloaded-system-search (requested)
(let ((name (coerce-name requested)))
(multiple-value-bind (keys foundp) (gethash name *preloaded-systems*)
(when foundp
(apply 'make-instance 'system :name name :source-file (getf keys :source-file) keys)))))
(defun register-preloaded-system (system-name &rest keys)
(setf (gethash (coerce-name system-name) *preloaded-systems*) keys))
(register-preloaded-system "asdf" :version *asdf-version*)
(register-preloaded-system "asdf-driver" :version *asdf-version*))
(initialize-source-registry)))))))
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.30.3: Another System Definition Facility.
;;; This is ASDF 2.30.4: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......
......@@ -63,9 +63,6 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be:
(systems-being-operated *systems-being-operated*)
(*systems-being-operated* (or systems-being-operated (make-hash-table :test 'equal)))
(system (component-system component)))
(setf (gethash (coerce-name system) *systems-being-operated*) system)
(unless (version-satisfies component version)
(error 'missing-component-of-version :requires component :version version))
;; Before we operate on any system, make sure ASDF is up-to-date,
;; for if an upgrade is ever attempted at any later time, there may be BIG trouble.
(unless systems-being-operated
......@@ -78,6 +75,9 @@ The :FORCE or :FORCE-NOT argument to OPERATE can be:
(apply (find-symbol* 'operate :asdf)
(unreify-symbol operation-name)
component-path args)))))
(setf (gethash (coerce-name system) *systems-being-operated*) system)
(unless (version-satisfies component version)
(error 'missing-component-of-version :requires component :version version))
(let ((plan (apply 'traverse operation system args)))
(perform-plan plan)
(values operation plan))))
......
......@@ -52,7 +52,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
;; "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.30.3")
(asdf-version "2.30.4")
(existing-version (asdf-version)))
(setf *asdf-version* asdf-version)
(when (and existing-version (not (equal asdf-version existing-version)))
......@@ -119,16 +119,11 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
(unless (equal old-version new-version)
(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)))
(if (version<= new-version old-version)
(error (compatfmt "~&~@<; ~@;Downgraded ASDF from version ~A to version ~A~@:>~%")
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*))
t))))
......@@ -137,7 +132,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
We need do that before we operate on anything that may possibly depend on ASDF."
(let ((*load-print* nil)
(*compile-print* nil))
(handler-bind (((or style-warning warning) #'muffle-warning))
(handler-bind (((or style-warning) #'muffle-warning))
(symbol-call :asdf :load-system :asdf :verbose nil))))
(register-hook-function '*post-upgrade-cleanup-hook* 'upgrade-configuration))
......
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