From 3bb042cba79176e99db2312f5be65f090c5e0e94 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lu=C3=ADs=20Oliveira?= Date: Sat, 16 May 2020 00:28:02 +0100 Subject: [PATCH 01/11] Improve interaction between find-definition and WITH-UPGRADABILITY If we don't discard the original defun or defgeneric form from the expansion, find-definition is able to pin point the correct form instead of falling back to the parent WITH-UPGRADABILITY form. --- uiop/utility.lisp | 42 +++++++++++++++++++----------------------- 1 file changed, 19 insertions(+), 23 deletions(-) diff --git a/uiop/utility.lisp b/uiop/utility.lisp index 1b8e4cf8..c985e776 100644 --- a/uiop/utility.lisp +++ b/uiop/utility.lisp @@ -46,24 +46,22 @@ ;; even if the signature and/or generic-ness of the function has changed. ;; For a generic function, this invalidates any previous DEFMETHOD. (eval-when (:load-toplevel :compile-toplevel :execute) - (macrolet - ((defdef (def* def) - `(defmacro ,def* (name formals &rest rest) - (destructuring-bind (name &key (supersede t)) - (if (or (atom name) (eq (car name) 'setf)) - (list name :supersede nil) - name) - (declare (ignorable supersede)) - `(progn - ;; We usually try to do it only for the functions that need it, - ;; which happens in asdf/upgrade - however, for ECL, we need this hammer. - ,@(when supersede - `((fmakunbound ',name))) - ,@(when (and #+(or clasp ecl) (symbolp name)) ; fails for setf functions on ecl - `((declaim (notinline ,name)))) - (,',def ,name ,formals ,@rest)))))) - (defdef defgeneric* defgeneric) - (defdef defun* defun)) + (defun frob-defun/defgeneric (form) + (assert (member (first form) '(defun defgeneric))) + (let ((name (second form))) + (destructuring-bind (name &key (supersede t)) + (if (or (atom name) (eq (car name) 'setf)) + (list name :supersede nil) + name) + (declare (ignorable supersede)) + `(progn + ;; We usually try to do it only for the functions that need it, + ;; which happens in asdf/upgrade - however, for ECL, we need this hammer. + ,@(when supersede + `((fmakunbound ',name))) + ,@(when (and #+(or clasp ecl) (symbolp name)) ; fails for setf functions on ecl + `((declaim (notinline ,name)))) + ,form)))) (defmacro with-upgradability ((&optional) &body body) "Evaluate BODY at compile- load- and run- times, with DEFUN and DEFGENERIC modified to also declare the functions NOTINLINE and to accept a wrapping the function name @@ -73,11 +71,9 @@ to supersede any previous definition." `(eval-when (:compile-toplevel :load-toplevel :execute) ,@(loop :for form :in body :collect (if (consp form) - (destructuring-bind (car . cdr) form - (case car - ((defun) `(defun* ,@cdr)) - ((defgeneric) `(defgeneric* ,@cdr)) - (otherwise form))) + (case (first form) + ((defun defgeneric) (frob-defun/defgeneric form)) + (otherwise form)) form))))) ;;; Magic debugging help. See contrib/debug.lisp -- GitLab From 32a579df0e942ab7a71a40250f26c171b405d8be Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau Date: Fri, 15 May 2020 23:44:44 -0400 Subject: [PATCH 02/11] Ensure upgradability without DEFUN* --- action.lisp | 2 +- output-translations.lisp | 4 ++-- parse-defsystem.lisp | 7 +++--- plan.lisp | 8 +++---- source-registry.lisp | 4 ++-- system.lisp | 11 +++++---- uiop/configuration.lisp | 2 +- uiop/lisp-build.lisp | 2 +- uiop/pathname.lisp | 2 +- uiop/utility.lisp | 49 ++++++++++++++++++++++------------------ upgrade.lisp | 26 ++++++++++++++------- 11 files changed, 67 insertions(+), 50 deletions(-) diff --git a/action.lisp b/action.lisp index 384df556..e47c1b6b 100644 --- a/action.lisp +++ b/action.lisp @@ -132,7 +132,7 @@ Use it in FORMAT control strings as ~/asdf-action:format-action/" ;;;; Detection of circular dependencies (with-upgradability () - (defun (action-valid-p) (operation component) + (defun action-valid-p (operation component) "Is this action valid to include amongst dependencies?" ;; If either the operation or component was resolved to nil, the action is invalid. ;; :if-feature will invalidate actions on components for which the features don't apply. diff --git a/output-translations.lisp b/output-translations.lisp index 7ea330d5..d2512ba0 100644 --- a/output-translations.lisp +++ b/output-translations.lisp @@ -194,7 +194,7 @@ and the order is by decreasing length of namestring of the source pathname.") (when inherit (process-output-translations (first inherit) :collect collect :inherit (rest inherit)))) - (defun* (process-output-translations-directive) (directive &key inherit collect) + (defun process-output-translations-directive (directive &key inherit collect) (if (atom directive) (ecase directive ((:enable-user-cache) @@ -287,7 +287,7 @@ effectively disabling the output translation facility." ;; Top-level entry-point to _use_ output-translations - (defun* (apply-output-translations) (path) + (defun apply-output-translations (path) (etypecase path (logical-pathname path) diff --git a/parse-defsystem.lisp b/parse-defsystem.lisp index a4586860..19c986d7 100644 --- a/parse-defsystem.lisp +++ b/parse-defsystem.lisp @@ -148,7 +148,8 @@ Please only define ~S and secondary systems with a name starting with ~S (e.g. ~ ;; Given a form used as :version specification, in the context of a system definition ;; in a file at PATHNAME, for given COMPONENT with given PARENT, normalize the form ;; to an acceptable ASDF-format version. - (defun* (normalize-version) (form &key pathname component parent) + (fmakunbound 'normalize-version) ;; signature changed between 2.27 and 2.31 + (defun normalize-version (form &key pathname component parent) (labels ((invalid (&optional (continuation "using NIL instead")) (warn (compatfmt "~@") form component parent pathname continuation)) @@ -293,11 +294,11 @@ COMPONENTS is a list of the explicitly defined children descriptions. SERIAL-P is non-NIL if each child in COMPONENTS should depend on the previous children.")) - (defun* stable-union (s1 s2 &key (test #'eql) (key 'identity)) + (defun stable-union (s1 s2 &key (test #'eql) (key 'identity)) (append s1 (remove-if #'(lambda (e2) (member (funcall key e2) (funcall key s1) :test test)) s2))) - (defun* (parse-component-form) (parent options &key previous-serial-components) + (defun (parse-component-form) (parent options &key previous-serial-components) (destructuring-bind (type name &rest rest &key (builtin-system-p () bspp) diff --git a/plan.lisp b/plan.lisp index e9a963e5..af67363f 100644 --- a/plan.lisp +++ b/plan.lisp @@ -224,7 +224,7 @@ to be meaningful, or could it just as well have been done in another Lisp image? ;;;; Visiting dependencies of an action and computing action stamps (with-upgradability () - (defun* (map-direct-dependencies) (operation component fun) + (defun map-direct-dependencies (operation component fun) "Call FUN on all the valid dependencies of the given action in the given plan" (loop :for (dep-o-spec . dep-c-specs) :in (component-depends-on operation component) :for dep-o = (find-operation operation dep-o-spec) @@ -234,7 +234,7 @@ to be meaningful, or could it just as well have been done in another Lisp image? :when (action-valid-p dep-o dep-c) :do (funcall fun dep-o dep-c)))) - (defun* (reduce-direct-dependencies) (operation component combinator seed) + (defun reduce-direct-dependencies (operation component combinator seed) "Reduce the direct dependencies to a value computed by iteratively calling COMBINATOR for each dependency action on the dependency's operation and component and an accumulator initialized with SEED." @@ -243,7 +243,7 @@ initialized with SEED." #'(lambda (dep-o dep-c) (setf seed (funcall combinator dep-o dep-c seed)))) seed) - (defun* (direct-dependencies) (operation component) + (defun direct-dependencies (operation component) "Compute a list of the direct dependencies of the action within the plan" (reverse (reduce-direct-dependencies operation component #'acons nil))) @@ -527,7 +527,7 @@ Update the VISITED-ACTIONS table with the known status, but don't add anything t :do (collect-action-dependencies plan (action-operation action) (action-component action))) (plan-actions plan))) - (defun* (required-components) (system &rest keys &key (goal-operation 'load-op) &allow-other-keys) + (defun required-components (system &rest keys &key (goal-operation 'load-op) &allow-other-keys) "Given a SYSTEM and a GOAL-OPERATION (default LOAD-OP), traverse the dependencies and return a list of the components involved in building the desired action." (with-asdf-session (:override t) diff --git a/source-registry.lisp b/source-registry.lisp index 60001022..a086cc88 100644 --- a/source-registry.lisp +++ b/source-registry.lisp @@ -233,11 +233,11 @@ after having found a .asd file? True by default.") (defgeneric process-source-registry (spec &key inherit register)) - (defun* (inherit-source-registry) (inherit &key register) + (defun inherit-source-registry (inherit &key register) (when inherit (process-source-registry (first inherit) :register register :inherit (rest inherit)))) - (defun* (process-source-registry-directive) (directive &key inherit register) + (defun process-source-registry-directive (directive &key inherit register) (destructuring-bind (kw &rest rest) (if (consp directive) directive (list directive)) (ecase kw ((:include) diff --git a/system.lisp b/system.lisp index 31ff92b0..b0588840 100644 --- a/system.lisp +++ b/system.lisp @@ -186,10 +186,11 @@ the primary one." (slot-value (find-system (primary-system-name system)) slot-name)))) (defmacro define-system-virtual-slot-reader (slot-name) - `(defun* ,(intern (concatenate 'string (string :system-) - (string slot-name))) - (system) - (system-virtual-slot-value system ',slot-name))) + (let ((name (intern (strcat (string :system-) (string slot-name))))) + `(progn + (fmakunbound ',name) ;; These were gf from defgeneric before 3.3.2.11 + (declaim (notinline ,name)) + (defun ,name (system) (system-virtual-slot-value system ',slot-name))))) (defmacro define-system-virtual-slot-readers () `(progn ,@(mapcar (lambda (slot-name) `(define-system-virtual-slot-reader ,slot-name)) @@ -214,7 +215,7 @@ the primary one." in which the system specification (.asd file) is located." (pathname-directory-pathname (system-source-file system-designator))) - (defun* (system-relative-pathname) (system name &key type) + (defun system-relative-pathname (system name &key type) "Given a SYSTEM, and a (Unix-style relative path) NAME of a file (or directory) of given TYPE, return the absolute pathname of a corresponding file under that system's source code pathname." (subpathname (system-source-directory system) name :type type)) diff --git a/uiop/configuration.lisp b/uiop/configuration.lisp index 0d652400..ba68db76 100644 --- a/uiop/configuration.lisp +++ b/uiop/configuration.lisp @@ -215,7 +215,7 @@ directive.") (declaim (ftype (function (t &key (:directory boolean) (:wilden boolean) (:ensure-directory boolean)) t) resolve-location)) - (defun* (resolve-location) (x &key ensure-directory wilden directory) + (defun resolve-location (x &key ensure-directory wilden directory) "Resolve location designator X into a PATHNAME" ;; :directory backward compatibility, until 2014-01-16: accept directory as well as ensure-directory (loop :with dirp = (or directory ensure-directory) diff --git a/uiop/lisp-build.lisp b/uiop/lisp-build.lisp index 12870ba3..557fae18 100644 --- a/uiop/lisp-build.lisp +++ b/uiop/lisp-build.lisp @@ -662,7 +662,7 @@ possibly in a different process. Otherwise just call THUNK." (defvar *compile-check* nil "A hook for user-defined compile-time invariants") - (defun* (compile-file*) (input-file &rest keys + (defun compile-file* (input-file &rest keys &key (compile-check *compile-check*) output-file warnings-file #+clisp lib-file #+(or clasp ecl mkcl) object-file #+sbcl emit-cfasl &allow-other-keys) diff --git a/uiop/pathname.lisp b/uiop/pathname.lisp index 23fb2066..1daf98cc 100644 --- a/uiop/pathname.lisp +++ b/uiop/pathname.lisp @@ -715,7 +715,7 @@ added to its DIRECTORY component. This is useful for output translations." :defaults pathname))) pathname))) - (defun* (translate-pathname*) (path absolute-source destination &optional root source) + (defun translate-pathname* (path absolute-source destination &optional root source) "A wrapper around TRANSLATE-PATHNAME to be used by the ASDF output-translations facility. PATH is the pathname to be translated. ABSOLUTE-SOURCE is an absolute pathname to use as source for translate-pathname, diff --git a/uiop/utility.lisp b/uiop/utility.lisp index c985e776..071e6bb7 100644 --- a/uiop/utility.lisp +++ b/uiop/utility.lisp @@ -12,7 +12,6 @@ ;; magic helper to define debugging functions: #:uiop-debug #:load-uiop-debug-utility #:*uiop-debug-utility* #:with-upgradability ;; (un)defining functions in an upgrade-friendly way - #:defun* #:defgeneric* #:nest #:if-let ;; basic flow control #:parse-body ;; macro definition helper #:while-collecting #:appendf #:length=n-p #:ensure-list ;; lists @@ -41,27 +40,33 @@ (in-package :uiop/utility) ;;;; Defining functions in a way compatible with hot-upgrade: -;; DEFUN* and DEFGENERIC* use FMAKUNBOUND to delete any previous fdefinition, -;; thus replacing the function without warning or error -;; even if the signature and/or generic-ness of the function has changed. -;; For a generic function, this invalidates any previous DEFMETHOD. +;; - The WTIH-UPGRADABILITY infrastructure below ensures that functions are declared NOTINLINE, +;; so that new definitions are always seen by all callers, even those up the stack. +;; - WITH-UPGRADABILITY also uses EVAL-WHEN so that definitions used by ASDF are in a limbo state +;; (especially for gf's) in between the COMPILE-OP and LOAD-OP operations on the defining file. +;; - THOU SHALT NOT redefine a function with a backward-incompatible semantics without renaming it. +;; - THOU SHALT change the name of a function whenever thou makest an incompatible change. +;; - For instance, when the meanings of NIL and T for timestamps was inverted, +;; functions in the STAMP<, STAMP<=, etc. family had to be renamed to TIMESTAMP<, TIMESTAMP<=, etc., +;; because the change other caused a huge incompatibility during upgrade. +;; - Whenever a function goes from a DEFUN to a DEFGENERIC, or the DEFGENERIC signature changes, etc., +;; even in a backward-compatible way, you MUST precede the definition by FMAKUNBOUND. +;; - Since FMAKUNBOUND will remove all the methods on the generic function, make sure that +;; all the methods required for ASDF to successfully continue compiling itself +;; shall be defined in the same file as the one with the FMAKUNBOUND. +;; - When a function goes from DEFGENERIC to DEFUN, you MAY have to use FMAKUNBOUND, too. +;; Please try the upgrade tests on all supported implementations and update this comment afterwards. +;; - For safety, you shall put the FMAKUNBOUND just before the DEFUN or DEFGENERIC, +;; in the same WITH-UPGRADABILITY form (and its implicit EVAL-WHEN). +;; - Any time you change a signature, please keep a comment specifying the first release after the change; +;; put that comment on the same line as FMAKUNBOUND, it you use FMAKUNBOUND. (eval-when (:load-toplevel :compile-toplevel :execute) - (defun frob-defun/defgeneric (form) - (assert (member (first form) '(defun defgeneric))) - (let ((name (second form))) - (destructuring-bind (name &key (supersede t)) - (if (or (atom name) (eq (car name) 'setf)) - (list name :supersede nil) - name) - (declare (ignorable supersede)) - `(progn - ;; We usually try to do it only for the functions that need it, - ;; which happens in asdf/upgrade - however, for ECL, we need this hammer. - ,@(when supersede - `((fmakunbound ',name))) - ,@(when (and #+(or clasp ecl) (symbolp name)) ; fails for setf functions on ecl - `((declaim (notinline ,name)))) - ,form)))) + (defun ensure-function-notinline (definition &aux (name (second definition))) + (assert (member (first definition) '(defun defgeneric))) + `(progn + ,(when (and #+(or clasp ecl) (symbolp name)) ; NB: fails for (SETF functions) on ECL + `(declaim (notinline ,name))) + ,definition)) (defmacro with-upgradability ((&optional) &body body) "Evaluate BODY at compile- load- and run- times, with DEFUN and DEFGENERIC modified to also declare the functions NOTINLINE and to accept a wrapping the function name @@ -72,7 +77,7 @@ to supersede any previous definition." ,@(loop :for form :in body :collect (if (consp form) (case (first form) - ((defun defgeneric) (frob-defun/defgeneric form)) + ((defun defgeneric) (ensure-function-notinline form)) (otherwise form)) form))))) diff --git a/upgrade.lisp b/upgrade.lisp index 9eb6a2e8..e2cc4d6c 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -108,18 +108,28 @@ previously-loaded version of ASDF." (when-upgrading () (let* ((previous-version (first *previous-asdf-versions*)) (redefined-functions ;; List of functions that changed incompatibly since 2.27: - ;; gf signature changed (should NOT happen), defun that became a generic function, - ;; method removed that will mess up with new ones (especially :around :before :after, - ;; more specific or call-next-method'ed method) and/or semantics otherwise modified. Oops. + ;; gf signature changed (should NOT happen), defun that became a generic function or + ;; the other way around, method removed that will mess up with new ones + ;; (especially :around :before :after, more specific or call-next-method'ed method) + ;; and/or semantics otherwise modified. Oops. ;; NB: it's too late to do anything about functions in UIOP! - ;; If you introduce some critical incompatibility there, you must change the function name. + ;; If you introduce some critical incompatibility there, you MUST change the function name. ;; Note that we don't need do anything about functions that changed incompatibly ;; from ASDF 2.26 or earlier: we wholly punt on the entire ASDF package in such an upgrade. - ;; Also note that we don't include the defgeneric=>defun, because they are - ;; done directly with defun* and need not trigger a punt on data. ;; See discussion at https://gitlab.common-lisp.net/asdf/asdf/merge_requests/36 - `(,@(when (version< previous-version "3.1.2") '(#:component-depends-on #:input-files)) ;; crucial methods *removed* before 3.1.2 - ,@(when (version< previous-version "3.1.7.20") '(#:find-component)))) + ;; and at https://gitlab.common-lisp.net/asdf/asdf/-/merge_requests/141 + `(,@(when (version< previous-version "2.31") '(#:normalize-version)) ;; pathname became &key + ,@(when (version< previous-version "3.1.2") '(#:component-depends-on #:input-files)) ;; crucial methods *removed* before 3.1.2 + ,@(when (version< previous-version "3.1.7.20") '(#:find-component)) + ,@(when (version< previous-version "3.2.0") '(#:required-components)) ; was a gf + ,@(when (version< previous-version "3.3.0") + '(#:action-valid-p #:map-direct-dependencies ;; were gfs with plan first + #:reduce-direct-dependencies #:direct-dependencies)) + ,@(when (version< previous-version "3.3.2.11") ;; were gfs + '(#:system-long-name #:system-description #:system-long-description + #:system-author #:system-maintainer #:system-mailto + #:system-homepage #:system-source-control + #:system-licence #:system-license #:system-version #:system-bug-tracker)))) (redefined-classes ;; redefining the classes causes interim circularities ;; with the old ASDF during upgrade, and many implementations bork -- GitLab From 408160223acbf2cd183a04f012a94ad86faebf88 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau Date: Sat, 16 May 2020 05:34:14 +0000 Subject: [PATCH 03/11] Remove unnecessary upgrades from defgeneric to defun --- upgrade.lisp | 17 +++++------------ 1 file changed, 5 insertions(+), 12 deletions(-) diff --git a/upgrade.lisp b/upgrade.lisp index e2cc4d6c..9615a581 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -108,28 +108,21 @@ previously-loaded version of ASDF." (when-upgrading () (let* ((previous-version (first *previous-asdf-versions*)) (redefined-functions ;; List of functions that changed incompatibly since 2.27: - ;; gf signature changed (should NOT happen), defun that became a generic function or - ;; the other way around, method removed that will mess up with new ones + ;; gf signature changed, defun that became a generic function (but not way around), + ;; method removed that will mess up with new ones ;; (especially :around :before :after, more specific or call-next-method'ed method) ;; and/or semantics otherwise modified. Oops. ;; NB: it's too late to do anything about functions in UIOP! ;; If you introduce some critical incompatibility there, you MUST change the function name. ;; Note that we don't need do anything about functions that changed incompatibly ;; from ASDF 2.26 or earlier: we wholly punt on the entire ASDF package in such an upgrade. + ;; Also, the strong constraints apply most importantly for functions called from + ;; the continuation of compiling or loading some of the code in ASDF or UIOP. ;; See discussion at https://gitlab.common-lisp.net/asdf/asdf/merge_requests/36 ;; and at https://gitlab.common-lisp.net/asdf/asdf/-/merge_requests/141 `(,@(when (version< previous-version "2.31") '(#:normalize-version)) ;; pathname became &key ,@(when (version< previous-version "3.1.2") '(#:component-depends-on #:input-files)) ;; crucial methods *removed* before 3.1.2 - ,@(when (version< previous-version "3.1.7.20") '(#:find-component)) - ,@(when (version< previous-version "3.2.0") '(#:required-components)) ; was a gf - ,@(when (version< previous-version "3.3.0") - '(#:action-valid-p #:map-direct-dependencies ;; were gfs with plan first - #:reduce-direct-dependencies #:direct-dependencies)) - ,@(when (version< previous-version "3.3.2.11") ;; were gfs - '(#:system-long-name #:system-description #:system-long-description - #:system-author #:system-maintainer #:system-mailto - #:system-homepage #:system-source-control - #:system-licence #:system-license #:system-version #:system-bug-tracker)))) + ,@(when (version< previous-version "3.1.7.20") '(#:find-component)))) ;; added &key registered (redefined-classes ;; redefining the classes causes interim circularities ;; with the old ASDF during upgrade, and many implementations bork -- GitLab From 0d9883a91881320b5e562ce4dbc481825103185c Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau Date: Sat, 16 May 2020 05:34:39 +0000 Subject: [PATCH 04/11] Update list of versions to test upgrade from --- test/run-tests.sh | 27 +++++++++++++++------------ tools/test-upgrade.lisp | 35 +++++++++++++++++++++++------------ 2 files changed, 38 insertions(+), 24 deletions(-) diff --git a/test/run-tests.sh b/test/run-tests.sh index 34a3a409..1adc5bf9 100755 --- a/test/run-tests.sh +++ b/test/run-tests.sh @@ -434,33 +434,36 @@ extract_all_tagged_asdf () { } valid_upgrade_test_p () { case "${1}:${2}:${3}" in - # It's damn slow. Also, for some reason, we punt on anything earlier than 2.25, - # and only need to test it once, below for 2.24. - abcl:1.*|abcl:2.00[0-9]:*|abcl:201[0-9]:*|abcl:2.2[0-3]:*) : ;; - # ccl fasl numbering broke loading of old asdf 2.0 - ccl:2.0[01]*|ccl:2.2[0-6]*) : ;; + # It's damn slow. Also, we punt on anything 2.26 or earlier. + abcl:1.*|abcl:2.[01]*|abcl:2.2[0-5]:*) : ;; # Allegro ships with versions 3*, so give up testing 2 # Also, unpatched Allegro 10 has bug updating from 2.26 and before allegro*:[12].*) : ;; - # My old ubuntu 10.04LTS clisp 2.44.1 came wired in + # ccl fasl numbering broke loading of old asdf 2.0. 2.27 has trouble with deferred-warnings. + ccl:2.[01]*|ccl:2.2[0-7]*) : ;; + # clasp only since 3.1.4.3 + clasp:2.*|clasp:3.0*|clasp:3.1.[0-4]*) : ;; + # CLISP: My old ubuntu 10.04LTS clisp 2.44.1 came wired in # with an antique ASDF 1.374 from CLC that can't be downgraded. # More recent CLISPs work. # 2.00[0-7] use UID, which fails on some old CLISPs. - # Note that for the longest time, CLISP has included 2.011 in its distribution. - # Now its hg repository includes 3.0.2.29, but clisp hasn't released in many years(!) + # Note that for the longest time, CLISP has included 2.011 in its source repository. + # Now its hg repository includes 3.x, but clisp hasn't released in many years(!) # We don't punt on upgrade anymore, so we can go at it! #clisp:2.00[0-7]:*|clisp:1.*|clisp:2.0[01]*|clisp:2.2[0-5]:*) : ;; - # CMUCL has problems with 2.32 and earlier because of + # CMUCL has problems with 3.2.1 and earlier because of # the redefinition of system's superclass component. - cmucl:1.*|cmucl:2.[012]*|cmucl:2.3[012]*) : ;; + cmucl:1.*|cmucl:2.*|cmucl:3.[012]*) : ;; # Skip many ECL tests, for various ASDF issues ecl*:1.*|ecl*:2.0[01]*|ecl*:2.20:*) : ;; # GCL 2.7.0 from late November 2013 is required, with ASDF 3.1.2 - gcl:REQUIRE:*|gcl:1.*|gcl:2.*|gcl:3.0*) : ;; + gcl:REQUIRE:*|gcl:1.*|gcl:2.*|gcl:3.0*|gcl:3.1.[0-3]*) : ;; # LispWorks is broken at ASDF 3.0.3, but can upgrade from earlier and later ASDFs. - lispworks:3.0.3:*) : ;; + lispworks:1*|lispworks:2.[0-2]*|lispworks:2.3[0-2]*|lispworks:3.0.3:*) : ;; # MKCL is only supported starting with specific versions 2.24, 2.26.x, 3.0.3.0.x, so skip. mkcl:[12]*|mkcl:3.0*) : ;; + # SBCL won't run ASDF 1 anymore + sbcl:1*) : ;; # XCL support starts with ASDF 2.014.2 # — It also dies during upgrade trying to show the backtrace. xcl:1.*|xcl:2.00*|xcl:2.01[0-4]:*|xcl:*) : ;; diff --git a/tools/test-upgrade.lisp b/tools/test-upgrade.lisp index e17015d6..15b4bbbc 100644 --- a/tools/test-upgrade.lisp +++ b/tools/test-upgrade.lisp @@ -16,7 +16,10 @@ ;; The 3.3 series provides the asdf3.3 feature, meaning users can rely on ;; all its new features (proper phase separation) as well as earlier features. - "3.3.1" ;; (2017-11-14) bug fixes, second and latest in 3.3 series + "3.3.4" ;; (2020-02-14) bug fixes, fifth and latest in 3.3 series + "3.3.3" ;; (2019-03-27) bug fixes, fourth in 3.3 series + "3.3.2" ;; (2018-05-04) bug fixes, third in 3.3 series + "3.3.1" ;; (2017-11-14) bug fixes, second in 3.3 series, SBCL has been stuck there for years "3.3.0" ;; (2017-10-06) first in 3.3 series ;; The 3.2 series provides the asdf3.2 feature, meaning users can rely on @@ -133,9 +136,10 @@ Use at a given tag, put it under build/asdf-${tag}.lisp" :allegro_64_s :allegromodern_64_s :allegro8_64_s :allegromodern8_64_s) (version<= "2.27" tag)) - ;; CCL fasl numbering broke loading of old asdf 2.0, and the punting for 2.26 fails, - ;; but who cares since CCL has always been shipping recent versions of ASDF. - ((:ccl) (version<= "2.27" tag)) + ;; CCL fasl numbering broke loading of old asdf 2.0, the punting for 2.26 fails, and + ;; 2.27 enables deferred-warnings then the new UIOP causes confusion with its changed format. + ;; But who cares since CCL has always been shipping recent versions of ASDF. + ((:ccl) (version<= "2.32" tag)) ;; CLASP is only supported as of 3.1.4.3 ((:clasp) (version<= "3.1.4.3" tag)) @@ -149,9 +153,9 @@ Use at a given tag, put it under build/asdf-${tag}.lisp" ;; However, whether we punt or don't punt, these should all work. ((:clisp) t) - ;; CMUCL has problems with 2.32 and earlier because of - ;; the redefinition of system's superclass component. - ((:cmucl) (version<= "2.33" tag)) + ;; CMUCL has problems with 3.2.1 and earlier because of the redefinition of + ;; some classes that causes its subtype to answer NIL when it shouldn't. + ((:cmucl) (version<= "3.3.0" tag)) ;; Skip many ECL tests, for various ASDF issues ((:ecl :ecl_bytecodes) (version<= "2.21" tag)) @@ -161,14 +165,20 @@ Use at a given tag, put it under build/asdf-${tag}.lisp" ;; against anything but the latest release. ((:gcl) (version<= "3.1.4" tag)) - ;; LispWorks is fine, but ASDF 3.0.3 has a bug and can't be loaded. - ((:lispworks) (not (equal "3.0.3" tag))) + ;; LispWorks is fine, but ASDF 3.0.3 can't be loaded due to a bug it has a bug, + ;; while 2.27 to 2.32 use system:pid-exit-status that doesn't exist anymore in LispWorks 7. + ((:lispworks) (and (version<= "2.33" tag) (not (equal "3.0.3" tag)))) ;; MKCL is only supported starting with specific versions 2.24, 2.26.x, 3.0.3.0.x, so skip. - ((:mkcl) (version<= "3.1.2" tag)) + ;; The bundle support also changed a lot in 3.2.0 and this breaks upgrading from 3.1. + ((:mkcl) (version<= "3.2.0" tag)) - ;; all clear on these implementations - ((:sbcl :scl) t) + ;; SBCL fails to load ASDF as a system 1.369 because ASDF 1.369's builtin + ;; asdf-binary-locations gets confused when SBCL_HOME is not set by SBCL anymore. + ((:sbcl) (version<= "2.000" tag)) + + ;; SCL is all good. + ((:scl) (version<= "2.000" tag)) ;; XCL support starts with ASDF 2.014.2 ;; — It also dies during upgrade trying to show the backtrace. @@ -196,6 +206,7 @@ Use the preferred lisp implementation" (extract-tagged-asdf tag) (run-test-lisp description `((load "test/script-support.lisp") + (asdf-test::debug-asdf) (asdf-test::test-upgrade ,@method ,tag)) :lisp lisp :log log)) description)) -- GitLab From 823c389f6d9089f54b83602d0e547c8f0709128c Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau Date: Sun, 17 May 2020 04:42:36 +0000 Subject: [PATCH 05/11] Make PACKAGE-LOCAL-NICKNAMES support upgradable --- test/test-package-local-nicknames.script | 18 ++-- uiop/driver.lisp | 19 ++-- uiop/package.lisp | 115 ++++++++++++++++------- uiop/utility.lisp | 8 +- 4 files changed, 103 insertions(+), 57 deletions(-) diff --git a/test/test-package-local-nicknames.script b/test/test-package-local-nicknames.script index 06700b87..3fa7b19e 100644 --- a/test/test-package-local-nicknames.script +++ b/test/test-package-local-nicknames.script @@ -62,7 +62,7 @@ :package-local-nicknames-test-1 :package-local-nicknames-test-2)) (let ((*package* (find-package p))) - (let ((alist (uiop/package:package-local-nicknames :package-local-nicknames-test-1))) + (let ((alist (uiop/package*:package-local-nicknames :package-local-nicknames-test-1))) (assert (equal (cons (case-lisp-string "L") (find-package :cl)) (assoc (case-lisp-string "L") alist :test 'string=))) (assert (equal (cons +nn-sname+ (find-package +pkg-sname+)) @@ -95,28 +95,28 @@ (define-test test-package-local-nicknames-nickname-removal (reset-test-packages) - (assert (= 2 (length (uiop/package:package-local-nicknames :package-local-nicknames-test-1)))) - (assert (uiop/package:remove-package-local-nickname :l :package-local-nicknames-test-1)) - (assert (= 1 (length (uiop/package:package-local-nicknames :package-local-nicknames-test-1)))) + (assert (= 2 (length (uiop/package*:package-local-nicknames :package-local-nicknames-test-1)))) + (assert (uiop/package*:remove-package-local-nickname :l :package-local-nicknames-test-1)) + (assert (= 1 (length (uiop/package*:package-local-nicknames :package-local-nicknames-test-1)))) (let ((*package* (find-package :package-local-nicknames-test-1))) (assert (not (find-package :l))))) (define-test test-package-local-nicknames-nickname-removal-char #+ignore (declare (optimize (debug 3) (speed 0))) (reset-test-packages) - (assert (= 2 (length (uiop/package:package-local-nicknames :package-local-nicknames-test-1)))) - (assert (uiop/package:remove-package-local-nickname (if (eq (readtable-case *readtable*) :preserve) #\l #\L) + (assert (= 2 (length (uiop/package*:package-local-nicknames :package-local-nicknames-test-1)))) + (assert (uiop/package*:remove-package-local-nickname (if (eq (readtable-case *readtable*) :preserve) #\l #\L) :package-local-nicknames-test-1)) - (assert (= 1 (length (uiop/package:package-local-nicknames :package-local-nicknames-test-1)))) + (assert (= 1 (length (uiop/package*:package-local-nicknames :package-local-nicknames-test-1)))) (let ((*package* (find-package :package-local-nicknames-test-1))) (assert (not (find-package :l))))) (define-test test-package-local-nicknames-nickname-removal-readd-another-package-equality (reset-test-packages) - (assert (uiop/package:remove-package-local-nickname :l :package-local-nicknames-test-1)) + (assert (uiop/package*:remove-package-local-nickname :l :package-local-nicknames-test-1)) (assert (eq (find-package :package-local-nicknames-test-1) - (uiop/package:add-package-local-nickname :l :package-local-nicknames-test-2 + (uiop/package*:add-package-local-nickname :l :package-local-nicknames-test-2 :package-local-nicknames-test-1))) (let ((*package* (find-package :package-local-nicknames-test-1))) (let ((cl (find-package :l)) diff --git a/uiop/driver.lisp b/uiop/driver.lisp index 9b7807d7..ca6aa2c1 100644 --- a/uiop/driver.lisp +++ b/uiop/driver.lisp @@ -2,18 +2,21 @@ ;;;; Re-export all the functionality in UIOP (uiop/package:define-package :uiop/driver - (:nicknames :uiop :asdf/driver) ;; asdf/driver is obsolete (uiop isn't); - ;; but asdf/driver is still used by swap-bytes, static-vectors. + (:nicknames :uiop ;; Official name we recommend should be used for all references to uiop symbols. + :asdf/driver) ;; DO NOT USE, a deprecated name, not supported anymore. + ;; We should remove the name :asdf/driver at some point, + ;; but not until it has been eradicated from Quicklisp for a year or two. + ;; The last known user was cffi (PR merged in May 2020). (:use :uiop/common-lisp) - ;; NB: not reexporting uiop/common-lisp - ;; which include all of CL with compatibility modifications on select platforms, - ;; that could cause potential conflicts for packages that would :use (cl uiop) - ;; or :use (closer-common-lisp uiop), etc. + ;; NB: We are not reexporting uiop/common-lisp + ;; which include all of CL with compatibility modifications on select platforms, + ;; because that would cause potential conflicts for packages that + ;; might want to :use (:cl :uiop) or :use (:closer-common-lisp :uiop), etc. (:use-reexport - :uiop/package :uiop/utility :uiop/version + :uiop/package* :uiop/utility :uiop/version :uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image :uiop/launch-program :uiop/run-program :uiop/lisp-build :uiop/configuration :uiop/backward-driver)) -;; Provide both lowercase and uppercase, to satisfy more people. +;; Provide both lowercase and uppercase, to satisfy more implementations. (provide "uiop") (provide "UIOP") diff --git a/uiop/package.lisp b/uiop/package.lisp index 61a48a01..10bd8583 100644 --- a/uiop/package.lisp +++ b/uiop/package.lisp @@ -4,39 +4,40 @@ ;; See https://bugs.launchpad.net/asdf/+bug/485687 ;; +;; CAUTION: The definition of the UIOP/PACKAGE package MUST NOT CHANGE, +;; NOT NOW, NOT EVER, NOT UNDER ANY CIRCUMSTANCE. NEVER. +;; ... and the same goes for UIOP/PACKAGE-LOCAL-NICKNAMES. +;; +;; The entire point of UIOP/PACKAGE is to address the fact that the CL standard +;; *leaves it unspecified what happens when a package is redefined incompatibly*. +;; For instance, SBCL 1.4.2 will signal a full WARNING when this happens, +;; throwing a wrench in upgrading code with ASDF itself, while continuing to +;; export old symbols it now shouldn't as it also exports new ones, +;; causing problems with code that relies on the new/current exports. +;; CLISP and CCL also exports both sets of symbols, though without any WARNING. +;; ABCL 1.6.1 will plainly ignore the new definition. +;; Other implementations may do whatever they want and change their behavior at any time. +;; ***Using DEFPACKAGE twice with different definitions is nasal-demon territory.*** +;; +;; Thus we define UIOP/PACKAGE:DEFINE-PACKAGE with which packages can be defined +;; in an upgrade-friendly way: the new definition is authoritative, and +;; the package will define and export exactly those symbols in the new definition, +;; no more and no fewer, whereas it is well-defined what happens to previous symbols. +;; However, for obvious bootstrap reasons, we cannot use DEFINE-PACKAGE +;; to define UIOP/PACKAGE itself, only DEFPACKAGE. +;; Therefore, unlike the other packages in ASDF, UIOP/PACKAGE is immutable, +;; now and forever. It is frozen for the aeons to come, like the CL package itself, +;; to the same exact state it was defined at its inception, in ASDF 2.27 in 2013. +;; The same goes for UIOP/PACKAGE-LOCAL-NICKNAMES, that we use internally. +;; +;; If you ever must define new symbols in this file, you can and must +;; export them from a different package, possibly defined in the same file, +;; say a package UIOP/PACKAGE* defined at the end of this file with DEFINE-PACKAGE, +;; that might use :import-from to import the symbols from UIOP/PACKAGE, +;; if you must somehow define them in UIOP/PACKAGE. -;;; package local nicknames feature. Can't be deferred until common-lisp.lisp, -;;; where most such features are set. -;;; ABCL and CCL already define this feature appropriately. -;;; Seems to be unconditionally present for SBCL, ACL, and clasp -;;; Don't know about ecl, or others - (eval-when (:load-toplevel :compile-toplevel :execute) - ;; abcl pushes :package-local-nicknames without UIOP interfering, - ;; and Lispworks will do so - #+(or sbcl clasp) - (pushnew :package-local-nicknames *features*) - #+allegro - (let ((fname (find-symbol (symbol-name '#:add-package-local-nickname) '#:excl))) - (when (and fname (fboundp fname)) - (pushnew :package-local-nicknames *features*)))) - -(defpackage :uiop/package - ;; CAUTION: we must handle the first few packages specially for hot-upgrade. - ;; This package definition MUST NOT change unless its name too changes; - ;; if/when it changes, don't forget to add new functions missing from below. - ;; Until then, uiop/package is frozen to forever - ;; import and export the same exact symbols as for ASDF 2.27. - ;; Any other symbol must be import-from'ed and re-export'ed in a different package. +(defpackage :uiop/package ;;; THOU SHALT NOT modify this definition, EVER. See explanations above. (:use :common-lisp) - #+package-local-nicknames - (:import-from #+allegro #:excl - #+sbcl #:sb-ext - #+(or clasp abcl ecl) #:ext - #+ccl #:ccl - #+lispworks #:hcl - #-(or allegro sbcl clasp abcl ccl lispworks ecl) - (error "Don't know from which package this lisp supplies the local-package-nicknames API.") - #:remove-package-local-nickname #:package-local-nicknames #:add-package-local-nickname) (:export #:find-package* #:find-symbol* #:symbol-call #:intern* #:export* #:import* #:shadowing-import* #:shadow* #:make-symbol* #:unintern* @@ -48,13 +49,43 @@ #:package-names #:packages-from-names #:fresh-package-name #:rename-package-away #:package-definition-form #:parse-define-package-form #:ensure-package #:define-package - #+package-local-nicknames #:add-package-local-nickname - #+package-local-nicknames #:remove-package-local-nickname - #+package-local-nicknames #:package-local-nicknames )) (in-package :uiop/package) +;;; package local nicknames feature. +;;; This can't be deferred until common-lisp.lisp, where most such features are set. +;;; ABCL and CCL already define this feature appropriately. +;;; Seems to be unconditionally present for SBCL, ACL, and CLASP +;;; Don't know about ECL, or others +(eval-when (:load-toplevel :compile-toplevel :execute) + ;; ABCL pushes :package-local-nicknames without UIOP interfering, + ;; and Lispworks will do so + #+(or sbcl clasp) + (pushnew :package-local-nicknames *features*) + #+allegro + (let ((fname (find-symbol (symbol-name '#:add-package-local-nickname) '#:excl))) + (when (and fname (fboundp fname)) + (pushnew :package-local-nicknames *features*)))) + +;;; THOU SHALT NOT modify this definition, EVER, *EXCEPT* to add a new implementation. +;; If you somehow need to modify the API in any way, +;; you will need to create another, differently named, and just as immutable package. +#+package-local-nicknames +(defpackage :uiop/package-local-nicknames + (:use :cl) + (:import-from + #+allegro #:excl + #+sbcl #:sb-ext + #+(or clasp abcl ecl) #:ext + #+ccl #:ccl + #+lispworks #:hcl + #-(or allegro sbcl clasp abcl ccl lispworks ecl) + (error "Don't know from which package this lisp supplies the local-package-nicknames API.") + #:remove-package-local-nickname #:package-local-nicknames #:add-package-local-nickname) + (:export + #:add-package-local-nickname #:remove-package-local-nickname #:package-local-nicknames)) + ;;;; General purpose package utilities (eval-when (:load-toplevel :compile-toplevel :execute) @@ -663,8 +694,15 @@ or when loading the package is optional." (rename-package package package-name nicknames) ;; Handle local nicknames #+package-local-nicknames - (install-package-local-nicknames package local-nicknames) - ;; handle uninterning unwanted symbols + (let* ((existing-nicknames (mapcar #'(lambda (x) (string (car x))) + (uiop/package-local-nicknames:package-local-nicknames package))) + (new-nicknames (mapcar #'(lambda (x) (string (first x))) local-nicknames)) + (to-remove (set-difference existing-nicknames new-nicknames :test 'equal))) + (map () #'(lambda (x) (uiop/package-local-nicknames:remove-package-local-nickname x package)) + to-remove) + (loop :for (nick-str package-str) :in local-nicknames + :do (uiop/package-local-nicknames:add-package-local-nickname + nick-str package-str package))) (dolist (name unintern) (multiple-value-bind (existing status) (find-symbol name package) (when status @@ -818,3 +856,8 @@ MIX directives, and reexport their contents as per the REEXPORT directive." #+(or clasp ecl gcl mkcl) (defpackage ,package (:use)) (eval-when (:compile-toplevel :load-toplevel :execute) ,ensure-form)))) + +;; This package, unlike UIOP/PACKAGE, is allowed to evolve and acquire new symbols or drop old ones. +(define-package :uiop/package* + (:use-reexport :uiop/package + #+package-local-nicknames :uiop/package-local-nicknames)) diff --git a/uiop/utility.lisp b/uiop/utility.lisp index 071e6bb7..e41bfae6 100644 --- a/uiop/utility.lisp +++ b/uiop/utility.lisp @@ -44,7 +44,8 @@ ;; so that new definitions are always seen by all callers, even those up the stack. ;; - WITH-UPGRADABILITY also uses EVAL-WHEN so that definitions used by ASDF are in a limbo state ;; (especially for gf's) in between the COMPILE-OP and LOAD-OP operations on the defining file. -;; - THOU SHALT NOT redefine a function with a backward-incompatible semantics without renaming it. +;; - THOU SHALT NOT redefine a function with a backward-incompatible semantics without renaming it, +;; at least if that function is used by ASDF while performing the plan to load ASDF. ;; - THOU SHALT change the name of a function whenever thou makest an incompatible change. ;; - For instance, when the meanings of NIL and T for timestamps was inverted, ;; functions in the STAMP<, STAMP<=, etc. family had to be renamed to TIMESTAMP<, TIMESTAMP<=, etc., @@ -53,9 +54,8 @@ ;; even in a backward-compatible way, you MUST precede the definition by FMAKUNBOUND. ;; - Since FMAKUNBOUND will remove all the methods on the generic function, make sure that ;; all the methods required for ASDF to successfully continue compiling itself -;; shall be defined in the same file as the one with the FMAKUNBOUND. -;; - When a function goes from DEFGENERIC to DEFUN, you MAY have to use FMAKUNBOUND, too. -;; Please try the upgrade tests on all supported implementations and update this comment afterwards. +;; shall be defined in the same file as the one with the FMAKUNBOUND, *after* the DEFGENERIC. +;; - When a function goes from DEFGENERIC to DEFUN, you may omit to use FMAKUNBOUND. ;; - For safety, you shall put the FMAKUNBOUND just before the DEFUN or DEFGENERIC, ;; in the same WITH-UPGRADABILITY form (and its implicit EVAL-WHEN). ;; - Any time you change a signature, please keep a comment specifying the first release after the change; -- GitLab From 27aebe81afed195eda142545dc5e888297fc1b4c Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau Date: Sun, 17 May 2020 05:15:40 +0000 Subject: [PATCH 06/11] Make redefined class upgrade properly on MKCL --- upgrade.lisp | 28 +++++++++++++--------------- 1 file changed, 13 insertions(+), 15 deletions(-) diff --git a/upgrade.lisp b/upgrade.lisp index 9615a581..af8d2ae6 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -124,17 +124,15 @@ previously-loaded version of ASDF." ,@(when (version< previous-version "3.1.2") '(#:component-depends-on #:input-files)) ;; crucial methods *removed* before 3.1.2 ,@(when (version< previous-version "3.1.7.20") '(#:find-component)))) ;; added &key registered (redefined-classes - ;; redefining the classes causes interim circularities ;; with the old ASDF during upgrade, and many implementations bork - #-clozure () - #+clozure - '((#:compile-concatenated-source-op (#:operation) ()) - (#:compile-bundle-op (#:operation) ()) - (#:concatenate-source-op (#:operation) ()) - (#:dll-op (#:operation) ()) - (#:lib-op (#:operation) ()) - (#:monolithic-compile-bundle-op (#:operation) ()) - (#:monolithic-concatenate-source-op (#:operation) ())))) + (when (or #+(or clozure mkcl) t) + '((#:compile-concatenated-source-op (#:operation) ()) + (#:compile-bundle-op (#:operation) ()) + (#:concatenate-source-op (#:operation) ()) + (#:dll-op (#:operation) ()) + (#:lib-op (#:operation) ()) + (#:monolithic-compile-bundle-op (#:operation) ()) + (#:monolithic-concatenate-source-op (#:operation) ()))))) (loop :for name :in redefined-functions :for sym = (find-symbol* name :asdf nil) :do (when sym (fmakunbound sym))) @@ -142,11 +140,11 @@ previously-loaded version of ASDF." (if (consp x) (values (car x) (cadr x)) (values x :asdf)) (find-symbol* s p nil))) (asyms (l) (mapcar #'asym l))) - (loop :for (name superclasses slots) :in redefined-classes - :for sym = (find-symbol* name :asdf nil) - :when (and sym (find-class sym)) - :do (eval `(defclass ,sym ,(asyms superclasses) ,(asyms slots))))))) - + (loop* :for (name superclasses slots) :in redefined-classes + :for sym = (find-symbol* name :asdf nil) + :when (and sym (find-class sym)) + :do #+ccl (eval `(defclass ,sym ,(asyms superclasses) ,(asyms slots))) + #-ccl (setf (find-class sym) nil))))) ;; mkcl ;;; Self-upgrade functions (with-upgradability () -- GitLab From 9d819a5f4774dbd3c085352fb6935767d29852d6 Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" Date: Sun, 16 May 2021 09:12:17 -0500 Subject: [PATCH 07/11] Fix rebase error. Kept part of the `defun*` for `parse-component-form` in rebase. --- parse-defsystem.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/parse-defsystem.lisp b/parse-defsystem.lisp index 19c986d7..52ac0ecd 100644 --- a/parse-defsystem.lisp +++ b/parse-defsystem.lisp @@ -298,7 +298,7 @@ children.")) (append s1 (remove-if #'(lambda (e2) (member (funcall key e2) (funcall key s1) :test test)) s2))) - (defun (parse-component-form) (parent options &key previous-serial-components) + (defun parse-component-form (parent options &key previous-serial-components) (destructuring-bind (type name &rest rest &key (builtin-system-p () bspp) -- GitLab From cb00a9190355ca60f57a898adc253cb61f38f3a3 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Thu, 3 Jun 2021 11:59:35 -0400 Subject: [PATCH 08/11] Remove a loop* (see !172) --- upgrade.lisp | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/upgrade.lisp b/upgrade.lisp index af8d2ae6..85ada263 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -140,11 +140,11 @@ previously-loaded version of ASDF." (if (consp x) (values (car x) (cadr x)) (values x :asdf)) (find-symbol* s p nil))) (asyms (l) (mapcar #'asym l))) - (loop* :for (name superclasses slots) :in redefined-classes - :for sym = (find-symbol* name :asdf nil) - :when (and sym (find-class sym)) - :do #+ccl (eval `(defclass ,sym ,(asyms superclasses) ,(asyms slots))) - #-ccl (setf (find-class sym) nil))))) ;; mkcl + (loop :for (name superclasses slots) :in redefined-classes + :for sym = (find-symbol* name :asdf nil) + :when (and sym (find-class sym)) + :do #+ccl (eval `(defclass ,sym ,(asyms superclasses) ,(asyms slots))) + #-ccl (setf (find-class sym) nil))))) ;; mkcl ;;; Self-upgrade functions (with-upgradability () -- GitLab From 789b75a8d82c95dcea26f7d34865db57182f8a86 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Thu, 3 Jun 2021 12:09:22 -0400 Subject: [PATCH 09/11] Revive the call to INSTALL-PACKAGE-LOCAL-NICKNAMES from !167 It got lost in an earlier rebase of this branch. --- uiop/package.lisp | 22 ++++++++-------------- 1 file changed, 8 insertions(+), 14 deletions(-) diff --git a/uiop/package.lisp b/uiop/package.lisp index 10bd8583..b8519737 100644 --- a/uiop/package.lisp +++ b/uiop/package.lisp @@ -636,13 +636,15 @@ or when loading the package is optional." #+package-local-nicknames (defun install-package-local-nicknames (destination-package new-nicknames) ;; First, remove all package-local nicknames. (We'll reinstall any desired ones later.) - (dolist (pair-to-remove (package-local-nicknames destination-package)) - (remove-package-local-nickname (string (car pair-to-remove)) destination-package)) + (dolist (pair-to-remove (uiop/package-local-nicknames:package-local-nicknames destination-package)) + (uiop/package-local-nicknames:remove-package-local-nickname + (string (car pair-to-remove)) destination-package)) ;; Then, install all desired nicknames. (loop :for (nickname package) :in new-nicknames - :do (add-package-local-nickname (string nickname) - (find-package package) - destination-package))) + :do (uiop/package-local-nicknames:add-package-local-nickname + (string nickname) + (find-package package) + destination-package))) (defun ensure-package (name &key nicknames documentation use @@ -694,15 +696,7 @@ or when loading the package is optional." (rename-package package package-name nicknames) ;; Handle local nicknames #+package-local-nicknames - (let* ((existing-nicknames (mapcar #'(lambda (x) (string (car x))) - (uiop/package-local-nicknames:package-local-nicknames package))) - (new-nicknames (mapcar #'(lambda (x) (string (first x))) local-nicknames)) - (to-remove (set-difference existing-nicknames new-nicknames :test 'equal))) - (map () #'(lambda (x) (uiop/package-local-nicknames:remove-package-local-nickname x package)) - to-remove) - (loop :for (nick-str package-str) :in local-nicknames - :do (uiop/package-local-nicknames:add-package-local-nickname - nick-str package-str package))) + (install-package-local-nicknames package local-nicknames) (dolist (name unintern) (multiple-value-bind (existing status) (find-symbol name package) (when status -- GitLab From 0fac334e9658b2ce1d0b17299d84d08157c19f63 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Thu, 3 Jun 2021 12:15:55 -0400 Subject: [PATCH 10/11] abcl upgrade tests no longer expected to fail in CI --- gitlab-pipelines/standard-pipeline.yml | 40 +++++++++++++++----------- 1 file changed, 23 insertions(+), 17 deletions(-) diff --git a/gitlab-pipelines/standard-pipeline.yml b/gitlab-pipelines/standard-pipeline.yml index c3d887ed..1ac3da55 100644 --- a/gitlab-pipelines/standard-pipeline.yml +++ b/gitlab-pipelines/standard-pipeline.yml @@ -116,13 +116,16 @@ Upgrade test: - l: [abcl, ccl, clasp, clisp, cmucl, ecl, sbcl] IMAGE_TAG: latest -Upgrade test known failure: - extends: .Upgrade test template - parallel: - matrix: - - l: [abcl] - IMAGE_TAG: latest - allow_failure: true +# No more tests are known to fail. But leave commented out in case it needs to +# be resurrected. + +# Upgrade test known failure: +# extends: .Upgrade test template +# parallel: +# matrix: +# - l: [] +# IMAGE_TAG: latest +# allow_failure: true .REQUIRE upgrade test template: extends: .Upgrade test template @@ -137,15 +140,18 @@ REQUIRE upgrade test: ASDF_UPGRADE_TEST_TAGS: REQUIRE parallel: matrix: - - l: [ccl, clasp, clisp, cmucl, ecl, sbcl] + - l: [abcl, ccl, clasp, clisp, cmucl, ecl, sbcl] IMAGE_TAG: latest -REQUIRE upgrade test known failure: - extends: .REQUIRE upgrade test template - variables: - ASDF_UPGRADE_TEST_TAGS: REQUIRE - parallel: - matrix: - - l: abcl - IMAGE_TAG: latest - allow_failure: true +# No more tests are known to fail. But leave commented out in case it needs to +# be resurrected. + +# REQUIRE upgrade test known failure: +# extends: .REQUIRE upgrade test template +# variables: +# ASDF_UPGRADE_TEST_TAGS: REQUIRE +# parallel: +# matrix: +# - l: [] +# IMAGE_TAG: latest +# allow_failure: true -- GitLab From 7b4a25ca88cd013f5d028c7328d249e73a19ef5f Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" Date: Thu, 3 Jun 2021 20:09:20 -0500 Subject: [PATCH 11/11] Update the Changelog prior to merging. --- doc/Changelog | 2 ++ 1 file changed, 2 insertions(+) diff --git a/doc/Changelog b/doc/Changelog index 2f4646df..fa8fa32a 100644 --- a/doc/Changelog +++ b/doc/Changelog @@ -19,6 +19,8 @@ cl-asdf (2:3.3.5-1) unstable; urgency=low IN PROGRESS * Fixes for feature handling from Eric Timmons. * Replaced some of the internals of `parse-defsystem` with generic functions to enable modular extension. Thanks to Eric Timmons. +* Faré provided more graceful upgrade capabilities, fixing bugs with upgrading + support for local package nicknames, and with upgrading ABCL. cl-asdf (2:3.3.4-1) unstable; urgency=low Bug fix release: -- GitLab