From 18c47d2f236c3dee72f9378340b4239dcecbcf7c Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Fri, 22 Feb 2013 15:21:28 -0500 Subject: [PATCH] 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. --- asdf.asd | 2 +- bin/asdf-builder | 4 +-- defsystem.lisp | 1 + find-system.lisp | 89 ++++++++++++++++++++++++++++++++++++----------- header.lisp | 2 +- operate.lisp | 6 ++-- upgrade.lisp | 19 ++++------ version.lisp-expr | 2 +- 8 files changed, 85 insertions(+), 40 deletions(-) diff --git a/asdf.asd b/asdf.asd index 9bd41e95c..9423c3889 100644 --- a/asdf.asd +++ b/asdf.asd @@ -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. diff --git a/bin/asdf-builder b/bin/asdf-builder index 058f14803..fe4a974dc 100755 --- a/bin/asdf-builder +++ b/bin/asdf-builder @@ -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 () diff --git a/defsystem.lisp b/defsystem.lisp index 548f28d6c..2763b5b48 100644 --- a/defsystem.lisp +++ b/defsystem.lisp @@ -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. diff --git a/find-system.lisp b/find-system.lisp index bcdb16453..09d3640b7 100644 --- a/find-system.lisp +++ b/find-system.lisp @@ -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))))))) diff --git a/header.lisp b/header.lisp index d9f7b520b..837fdd5f9 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;;; -*- 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>. diff --git a/operate.lisp b/operate.lisp index d1aebdeb2..0195a60cf 100644 --- a/operate.lisp +++ b/operate.lisp @@ -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)))) diff --git a/upgrade.lisp b/upgrade.lisp index 14eb0fa38..dbad10305 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -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)) diff --git a/version.lisp-expr b/version.lisp-expr index 464913af6..fb738892d 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1 +1 @@ -"2.30.3" +"2.30.4" -- GitLab