From 95e97e1df0236f1c2a0673948a90269197bf4f24 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Fri, 16 Apr 2021 16:50:49 -0400 Subject: [PATCH 01/49] Make version normalization and strings more flexible --- bundle.lisp | 2 +- component.lisp | 27 ++++++++++++------ interface.lisp | 1 + parse-defsystem.lisp | 66 ++++++++++++++++++++++++++++++++------------ system-registry.lisp | 2 +- system.lisp | 19 +++++++++---- 6 files changed, 84 insertions(+), 33 deletions(-) diff --git a/bundle.lisp b/bundle.lisp index 2d8d7307..c266edd8 100644 --- a/bundle.lisp +++ b/bundle.lisp @@ -444,7 +444,7 @@ or of opaque libraries shipped along the source code.")) (library (second inputs)) (asd (output-file o s)) (name (if (and fasl asd) (pathname-name asd) (return-from perform))) - (version (component-version s)) + (version (nth-value 1 (component-version s))) (dependencies (if (operation-monolithic-p o) ;; We want only dependencies, and we use basic-load-op rather than load-op so that diff --git a/component.lisp b/component.lisp index 601f5930..2752b206 100644 --- a/component.lisp +++ b/component.lisp @@ -65,11 +65,13 @@ Use asdf-encodings to support more encodings.")) (:documentation "Check whether a COMPONENT satisfies the constraint of being at least as recent as the specified VERSION, which must be a string of dot-separated natural numbers, or NIL.")) (defgeneric component-version (component) - (:documentation "Return the version of a COMPONENT, which must be a string of dot-separated -natural numbers, or NIL.")) + (:documentation "Return the version of a COMPONENT in two VALUES. The +first value is a string of dot-separated natural numbers that specifies the +primary version number, or NIL. The second value is the full version string +that is suitable for display and may contain pre- or post-release information, +or NIL.")) ;; ASDF internals never use the second value. (defgeneric (setf component-version) (new-version component) - (:documentation "Updates the version of a COMPONENT, which must be a string of dot-separated -natural numbers, or NIL.")) + (:documentation "Updates the version of a COMPONENT.")) (defgeneric component-parent (component) (:documentation "The parent of a child COMPONENT, or NIL for top-level components (a.k.a. systems)")) @@ -92,10 +94,7 @@ or NIL for top-level components (a.k.a. systems)")) (defclass component () ((name :accessor component-name :initarg :name :type string :documentation "Component name: designator for a string composed of portable pathname characters") - ;; We might want to constrain version with - ;; :type (and string (satisfies parse-version)) - ;; but we cannot until we fix all systems that don't use it correctly! - (version :accessor component-version :initarg :version :initform nil) + (version :initarg :version :initform nil) (description :accessor component-description :initarg :description :initform nil) (long-description :accessor component-long-description :initarg :long-description :initform nil) (sideway-dependencies :accessor component-sideway-dependencies :initform nil) @@ -162,7 +161,17 @@ The return value is a list of component NAMES; a list of strings." (defmethod component-system ((component component)) (if-let (system (component-parent component)) (component-system system) - component))) + component)) + + (defmethod component-version ((component component)) + "This method assumes that version has been normalized to a string of +dot-separated natural numbers." + (let ((v (slot-value component 'version))) + (values v v))) + + (defmethod (setf component-version) (value (component component)) + (setf (slot-value component 'version) value) + (values value value))) ;;;; Component hierarchy within a system diff --git a/interface.lisp b/interface.lisp index f2d322b1..5f63e099 100644 --- a/interface.lisp +++ b/interface.lisp @@ -72,6 +72,7 @@ #:component-system #:component-encoding #:component-external-format + #:normalize-component-version #:system-description #:system-long-description #:system-author diff --git a/parse-defsystem.lisp b/parse-defsystem.lisp index 52ac0ecd..187d52b5 100644 --- a/parse-defsystem.lisp +++ b/parse-defsystem.lisp @@ -21,6 +21,8 @@ #:known-system-with-bad-secondary-system-names-p #:sysdef-error-component #:check-component-input #:explain + ;; For extending version strings + #:normalize-component-version ;; for extending the component types #:compute-component-children #:class-for-type)) @@ -145,6 +147,30 @@ Please only define ~S and secondary systems with a name starting with ~S (e.g. ~ (pushnew pathname (cdr cell) :test 'pathname-equal) (values))) + (defun* (parse-version-pointer) (form &key pathname) + "Given a form used as a :version specification, in the context of a system +definition in a file at PATHNAME, attempt to read the form as part of ASDF's +mini-DSL for reading version information from another file. If FORM is not a +member of the DSL, the FORM is returned as is. A second value is returned +specifying the pathname that was used to derive the return value, if any." + (if (listp form) + (case (first form) + ((:read-file-form) + (destructuring-bind (subpath &key (at 0)) (rest form) + (let ((path (subpathname pathname subpath))) + (values (safe-read-file-form path + :at at :package :asdf-user) + path)))) + ((:read-file-line) + (destructuring-bind (subpath &key (at 0)) (rest form) + (let ((path (subpathname pathname subpath))) + (values (safe-read-file-line (subpathname pathname subpath) + :at at) + path)))) + (otherwise + form)) + form)) + ;; 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. @@ -163,26 +189,28 @@ Please only define ~S and secondary systems with a name starting with ~S (e.g. ~ (invalid "Substituting a string") (format nil "~D" form)) ;; 1.0 becomes "1.0" (cons - (case (first form) - ((:read-file-form) - (destructuring-bind (subpath &key (at 0)) (rest form) - (let ((path (subpathname pathname subpath))) - (record-additional-system-input-file path component parent) - (safe-read-file-form path - :at at :package :asdf-user)))) - ((:read-file-line) - (destructuring-bind (subpath &key (at 0)) (rest form) - (let ((path (subpathname pathname subpath))) - (record-additional-system-input-file path component parent) - (safe-read-file-line (subpathname pathname subpath) - :at at)))) - (otherwise - (invalid)))) + ;; We shouldn't ever get here now that parsing version + ;; pointers happens before normalizing the version, but + ;; leave for backwards compatibility. Consider removing in + ;; ASDF 4. + (multiple-value-bind (version-form additional-input-file) + (parse-version-pointer form :pathname pathname) + (when additional-input-file + (record-additional-system-input-file additional-input-file component parent)) + version-form)) (t (invalid)))) (if-let (pv (parse-version v #'invalid-parse)) (unparse-version pv) - (invalid)))))) + (invalid))))) + + (defgeneric* (normalize-component-version) (component form &key pathname parent) + (:documentation "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 object that can be stored in the +COMPONENT's VERSION slot.") + (:method ((component component) form &key pathname parent) + (normalize-version form :pathname pathname :component component :parent parent)))) ;;; "inline methods" @@ -345,7 +373,11 @@ children.")) (let ((sysfile (system-source-file (component-system component)))) ;; requires the previous (when (and (typep component 'system) (not bspp)) (setf (builtin-system-p component) (lisp-implementation-pathname-p sysfile))) - (setf version (normalize-version version :component name :parent parent :pathname sysfile))) + (multiple-value-bind (version-form additional-input-file) + (parse-version-pointer version :pathname sysfile) + (setf version version-form) + (when additional-input-file + (record-additional-system-input-file additional-input-file component parent)))) ;; Don't use the accessor: kluge to avoid upgrade issue on CCL 1.8. ;; A better fix is required. (setf (slot-value component 'version) version) diff --git a/system-registry.lisp b/system-registry.lisp index 71e286fd..23f10627 100644 --- a/system-registry.lisp +++ b/system-registry.lisp @@ -100,7 +100,7 @@ If VERSION is the default T, and a system was already loaded, then its version w (let ((name (coerce-name system-name))) (when (eql version t) (if-let (system (registered-system name)) - (setf (getf keys :version) (component-version system)))) + (setf (getf keys :version) (nth-value 1 (component-version system))))) (setf (gethash name *preloaded-systems*) keys) (ensure-preloaded-system-registered system-name))) diff --git a/system.lisp b/system.lisp index b0588840..648b1e0f 100644 --- a/system.lisp +++ b/system.lisp @@ -172,10 +172,10 @@ NB: The onus is unhappily on the user to avoid clashes." ;;; System virtual slot readers, recursing to the primary system if needed. (with-upgradability () - (defvar *system-virtual-slots* '(long-name description long-description - author maintainer mailto - homepage source-control - licence version bug-tracker) + (defparameter *system-virtual-slots* '(long-name description long-description + author maintainer mailto + homepage source-control + licence bug-tracker) "The list of system virtual slot names.") (defun system-virtual-slot-value (system slot-name) "Return SYSTEM's virtual SLOT-NAME value. @@ -197,7 +197,16 @@ the primary one." *system-virtual-slots*))) (define-system-virtual-slot-readers) (defun system-license (system) - (system-virtual-slot-value system 'licence))) + (system-virtual-slot-value system 'licence)) + ;; ASDF4: Move this back into *system-virtual-slots*. We can't return the + ;; slot directly as we want to mimic the result of COMPONENT-VERSION which + ;; now returns two VALUES. + (defun* system-version (system) + (let ((direct-version (multiple-value-list (component-version system)))) + (if (first direct-version) + (values-list direct-version) + (unless (primary-system-p system) + (component-version (find-system (primary-system-name system)))))))) ;;;; Pathnames -- GitLab From 984b99958d0c8feebc8af59273a0f9258d43a370 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 18 Apr 2021 14:34:56 -0400 Subject: [PATCH 02/49] Expand the default version functions to know about prerelease versions Adopt a version string grammar and ordering rules very similar to semver v2.0. However, do not limit the core version to exactly three numbers and do not adopt the compatibility semantics where bumping major versions causes incompatibilites. --- test/test-version.script | 15 ++++ uiop/version.lisp | 146 +++++++++++++++++++++++++++++++-------- 2 files changed, 134 insertions(+), 27 deletions(-) diff --git a/test/test-version.script b/test/test-version.script index 295e108a..6868fa27 100644 --- a/test/test-version.script +++ b/test/test-version.script @@ -1,5 +1,20 @@ ;;; -*- Lisp -*- +(DBG "Check version parsing and precedence operations") +(assert (version< "1.0.0" "2.0.0")) +(assert (version< "2.0.0" "2.1.0")) +(assert (version< "2.1.0" "2.1.1")) + +(assert (version< "1.0.0-alpha" "1.0.0")) + +(assert (version< "1.0.0-alpha" "1.0.0-alpha.1")) +(assert (version< "1.0.0-alpha.1" "1.0.0-alpha.beta")) +(assert (version< "1.0.0-alpha.beta" "1.0.0-beta")) +(assert (version< "1.0.0-beta" "1.0.0-beta.2")) +(assert (version< "1.0.0-beta.2" "1.0.0-beta.11")) +(assert (version< "1.0.0-beta.11" "1.0.0-rc.1")) +(assert (version< "1.0.0-rc.1" "1.0.0")) + (DBG "Check that there is an ASDF version that correctly parses to a non-empty list") (assert (consp (parse-version (asdf-version) 'error))) (DBG "Check that ASDF is newer than 1.234") diff --git a/uiop/version.lisp b/uiop/version.lisp index c34c22fb..5273ddd7 100644 --- a/uiop/version.lisp +++ b/uiop/version.lisp @@ -14,36 +14,110 @@ (with-upgradability () (defparameter *uiop-version* "3.3.5.7") - (defun unparse-version (version-list) - "From a parsed version (a list of natural numbers), compute the version string" - (format nil "~{~D~^.~}" version-list)) + (defparameter *pre-release-and-build-metadata-chars* + '(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m + #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z + #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M + #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z + #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 + #\-)) + + (defun unparse-version (version-list &optional pre-release-list build-metadata) + "From a parsed version (a list of natural numbers), compute the version +string. VERSION-LIST is a list of natural numbers. PRE-RELEASE-LIST is a list +of pre-release identifiers (strings or natural numbers). BUILD-METADATA is a +list of build metadata identifiers (strings or )string or NIL." + (format nil "~{~D~^.~}~@[-~{~A~^.~}~]~@[+~{~A~^.~}~]" version-list pre-release-list build-metadata)) + + (defun split-version-string (version-string) + "Given a semver string, split it into its three basic components: the core +segment, the pre-release segment, and the build segment. Returns the three +components in a list. If the component is missing from the string, it returns +nil." + (let ((pre-release-separator-position (position #\- version-string)) + (build-separator-position (position #\+ version-string))) + ;; If the pre-release and build separators both exist and the former comes + ;; after the latter, treat the former as not existing. + (when (and pre-release-separator-position + build-separator-position + (> pre-release-separator-position build-separator-position)) + (setf pre-release-separator-position nil)) + (list + ;; The core segment + (subseq version-string 0 (or pre-release-separator-position + build-separator-position)) + ;; The pre-release segment + (when pre-release-separator-position + (subseq version-string (1+ pre-release-separator-position) + build-separator-position)) + ;; The build segment + (when build-separator-position + (subseq version-string (1+ build-separator-position)))))) (defun parse-version (version-string &optional on-error) - "Parse a VERSION-STRING as a series of natural numbers separated by dots. -Return a (non-null) list of integers if the string is valid; -otherwise return NIL. - -When invalid, ON-ERROR is called as per CALL-FUNCTION before to return NIL, -with format arguments explaining why the version is invalid. -ON-ERROR is also called if the version is not canonical -in that it doesn't print back to itself, but the list is returned anyway." + "Parse a VERSION-STRING as a core version followed by an optional +pre-release segment (preceded by a -), followed by an optional build metadata +segment (preceded by a +). Each segment is returned as a separate VALUE. + +The core version segment must consist entirely of natural numbers separated by +dots. The pre-release segment consists of a series of identifiers (consisting +of the characters 0-9, a-z, A-Z, and -), separated by dots. The build metadata +segment consists of a series of identifiers (consisting of the characters 0-9, +a-z, A-Z, and -), separated by dots. + +This grammar is heavily inspired by semver v2.0's grammar with the major +difference that the core version segment is not limited to exactly three dot +separated natural numbers. + +When invalid, ON-ERROR is called as per CALL-FUNCTION before returning NIL, +with format arguments explaining why the version is invalid. ON-ERROR is also +called if the version is not canonical in that it doesn't print back to itself, +but the values are returned anyway." (block nil (unless (stringp version-string) (call-function on-error "~S: ~S is not a string" 'parse-version version-string) (return)) - (unless (loop :for prev = nil :then c :for c :across version-string - :always (or (digit-char-p c) - (and (eql c #\.) prev (not (eql prev #\.)))) - :finally (return (and c (digit-char-p c)))) - (call-function on-error "~S: ~S doesn't follow asdf version numbering convention" - 'parse-version version-string) - (return)) - (let* ((version-list - (mapcar #'parse-integer (split-string version-string :separator "."))) - (normalized-version (unparse-version version-list))) - (unless (equal version-string normalized-version) - (call-function on-error "~S: ~S contains leading zeros" 'parse-version version-string)) - version-list))) + (destructuring-bind (core-segment-string pre-release-segment-string build-segment-string) + (split-version-string version-string) + (labels ((invalid () + (call-function on-error "~S: ~S doesn't follow asdf version numbering convention" + 'parse-version version-string)) + (parse-dot-separated-segment (segment-string character-test transform) + (unless (loop :for prev = nil :then c :for c :across segment-string + :always (or (funcall character-test c) + (and (eql c #\.) prev (not (eql prev #\.)))) + :finally (return (and c (funcall character-test c)))) + (invalid) + (return)) + (mapcar transform (split-string segment-string :separator "."))) + (parse-core-segment (segment-string) + (parse-dot-separated-segment segment-string #'digit-char-p #'parse-integer)) + (parse-pre-release-segment (segment-string) + (parse-dot-separated-segment segment-string + (lambda (c) + (member c *pre-release-and-build-metadata-chars*)) + (lambda (x) + (let ((as-integer (ignore-errors (parse-integer x)))) + (if (and as-integer (not (minusp as-integer))) + as-integer + x))))) + (parse-build-segment (segment-string) + (parse-dot-separated-segment segment-string + (lambda (c) + (member c *pre-release-and-build-metadata-chars*)) + #'identity))) + (unless core-segment-string + (invalid) + (return)) + (let* ((core-segment (parse-core-segment core-segment-string)) + (pre-release-segment (when pre-release-segment-string + (parse-pre-release-segment pre-release-segment-string))) + (build-segment (when build-segment-string + (parse-build-segment build-segment-string))) + (normalized-version (unparse-version core-segment pre-release-segment build-segment))) + (unless (equal version-string normalized-version) + (call-function on-error "~S: ~S contains leading zeros" 'parse-version version-string)) + (values core-segment pre-release-segment build-segment normalized-version)))))) (defun next-version (version) "When VERSION is not nil, it is a string, then parse it as a version, compute the next version @@ -55,9 +129,27 @@ and return it as a string." (defun version< (version1 version2) "Given two version strings, return T if the second is strictly newer" - (let ((v1 (parse-version version1 nil)) - (v2 (parse-version version2 nil))) - (lexicographic< '< v1 v2))) + (multiple-value-bind (core-1 pre-release-1) + (parse-version version1) + (multiple-value-bind (core-2 pre-release-2) + (parse-version version2) + (labels ((identifier< (id1 id2) + (cond + ((and (integerp id1) (integerp id2)) + (< id1 id2)) + ((integerp id1) + t) + ((integerp id2) + nil) + (t + (string< id1 id2)))) + (pre-release-< (pr1 pr2) + (or + (and pr1 (null pr2)) + (lexicographic< #'identifier< pr1 pr2)))) + (or (lexicographic< '< core-1 core-2) + (and (equal core-1 core-2) + (pre-release-< pre-release-1 pre-release-2))))))) (defun version<= (version1 version2) "Given two version strings, return T if the second is newer or the same" -- GitLab From 2e5a924538895770a31adaa43febaa01fe7999b8 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 18 Apr 2021 14:41:22 -0400 Subject: [PATCH 03/49] Update built-in version functions to account for pre-release info VERSION slot now prefers to store a list of two values: the core version number and the full version. NORMALIZE-VERSION is updated to return such a list. COMPONENT-VERSION and (SETF COMPONENT-VERSION) updated to handle the VERSION slot being a list as well. --- component.lisp | 21 +++++++++++++++++---- parse-defsystem.lisp | 12 +++++++++--- 2 files changed, 26 insertions(+), 7 deletions(-) diff --git a/component.lisp b/component.lisp index 2752b206..bd4996a2 100644 --- a/component.lisp +++ b/component.lisp @@ -166,12 +166,25 @@ The return value is a list of component NAMES; a list of strings." (defmethod component-version ((component component)) "This method assumes that version has been normalized to a string of dot-separated natural numbers." - (let ((v (slot-value component 'version))) - (values v v))) + (if-let (raw-version (slot-value component 'version)) + (typecase raw-version + (string + ;; If we're upgrading ASDF and some systems have already been loaded, + ;; they likely have the old representation of the version (plain + ;; string) stored. We could automatically rewrite the contents of the + ;; slot if this happens, but it should be rare since ASDF always tries + ;; to upgrade itself first. + (if-let (core-segment (parse-version raw-version)) + (values core-segment raw-version))) + (cons + (values-list raw-version))))) (defmethod (setf component-version) (value (component component)) - (setf (slot-value component 'version) value) - (values value value))) + (when (typep value 'string) + (if-let (core-segment (parse-version value)) + (progn + (setf (slot-value component 'version) (list core-segment value)) + (values core-segment value)))))) ;;;; Component hierarchy within a system diff --git a/parse-defsystem.lisp b/parse-defsystem.lisp index 187d52b5..e4b2b44d 100644 --- a/parse-defsystem.lisp +++ b/parse-defsystem.lisp @@ -200,9 +200,15 @@ specifying the pathname that was used to derive the return value, if any." version-form)) (t (invalid)))) - (if-let (pv (parse-version v #'invalid-parse)) - (unparse-version pv) - (invalid))))) + (multiple-value-bind (core-segment pre-release-segment build-segment) + (parse-version v #'invalid-parse) + (if core-segment + ;; Store both the core segment (which we use for version + ;; comparisons) and the full version. This prevents calls to + ;; PARSE-VERSION from within COMPONENT-VERSION. + (list core-segment + (unparse-version core-segment pre-release-segment build-segment)) + (invalid)))))) (defgeneric* (normalize-component-version) (component form &key pathname parent) (:documentation "Given a form used as :version specification, in the -- GitLab From 66f26ef1eee74b8eb728f81de92b36372838bbfc Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 18 Apr 2021 15:03:34 -0400 Subject: [PATCH 04/49] Add :AROUND methods to COMPONENT-VERSION Use to adapt existing implementations to updated API that requires two return VALUES. --- component.lisp | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/component.lisp b/component.lisp index bd4996a2..63243a7d 100644 --- a/component.lisp +++ b/component.lisp @@ -184,7 +184,21 @@ dot-separated natural numbers." (if-let (core-segment (parse-version value)) (progn (setf (slot-value component 'version) (list core-segment value)) - (values core-segment value)))))) + (values core-segment value))))) + + ;; Adapt any existing implementation of COMPONENT-VERSION to the new + ;; interface. + (defmethod component-version :around ((component component)) + (let ((next-values (multiple-value-list (call-next-method)))) + (if (and (first next-values) (null (second next-values))) + (values (first next-values) (first next-values)) + (values-list next-values)))) + + (defmethod (setf component-version) :around (value (component component)) + (let ((next-values (multiple-value-list (call-next-method)))) + (if (and (first next-values) (null (second next-values))) + (component-version component) + (values-list next-values))))) ;;;; Component hierarchy within a system -- GitLab From cbffcedd863e977fac8eebaff59752052e2fcaba Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 18 Apr 2021 15:15:14 -0400 Subject: [PATCH 05/49] Tweak some slot-boundp checks --- component.lisp | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/component.lisp b/component.lisp index 63243a7d..d242a75a 100644 --- a/component.lisp +++ b/component.lisp @@ -166,7 +166,8 @@ The return value is a list of component NAMES; a list of strings." (defmethod component-version ((component component)) "This method assumes that version has been normalized to a string of dot-separated natural numbers." - (if-let (raw-version (slot-value component 'version)) + (if-let (raw-version (and (slot-boundp component 'version) + (slot-value component 'version))) (typecase raw-version (string ;; If we're upgrading ASDF and some systems have already been loaded, @@ -349,7 +350,7 @@ this compilation, or check its results, etc.")) (defmethod version-satisfies :around ((c t) (version null)) t) (defmethod version-satisfies ((c component) version) - (unless (and version (slot-boundp c 'version) (component-version c)) + (unless (and version (component-version c)) (when version (warn "Requested version ~S but ~S has no version" version c)) (return-from version-satisfies nil)) -- GitLab From e4e8967283b3205a0f7948b1cbfc02a27779bc76 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 18 Apr 2021 15:26:48 -0400 Subject: [PATCH 06/49] Fix bug that returned lists from COMPONENT-VERSION --- component.lisp | 8 ++++---- parse-defsystem.lisp | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/component.lisp b/component.lisp index d242a75a..ee2100d1 100644 --- a/component.lisp +++ b/component.lisp @@ -176,16 +176,16 @@ dot-separated natural numbers." ;; slot if this happens, but it should be rare since ASDF always tries ;; to upgrade itself first. (if-let (core-segment (parse-version raw-version)) - (values core-segment raw-version))) + (values (unparse-version core-segment) raw-version))) (cons (values-list raw-version))))) (defmethod (setf component-version) (value (component component)) (when (typep value 'string) (if-let (core-segment (parse-version value)) - (progn - (setf (slot-value component 'version) (list core-segment value)) - (values core-segment value))))) + (let ((core-string (unparse-version core-segment))) + (setf (slot-value component 'version) (list core-string value)) + (values core-string value))))) ;; Adapt any existing implementation of COMPONENT-VERSION to the new ;; interface. diff --git a/parse-defsystem.lisp b/parse-defsystem.lisp index e4b2b44d..fe269233 100644 --- a/parse-defsystem.lisp +++ b/parse-defsystem.lisp @@ -206,7 +206,7 @@ specifying the pathname that was used to derive the return value, if any." ;; Store both the core segment (which we use for version ;; comparisons) and the full version. This prevents calls to ;; PARSE-VERSION from within COMPONENT-VERSION. - (list core-segment + (list (unparse-version core-segment) (unparse-version core-segment pre-release-segment build-segment)) (invalid)))))) -- GitLab From a7027cec8653600e0fa3c02e7b3d9b22cd18b5bf Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 18 Apr 2021 16:53:08 -0400 Subject: [PATCH 07/49] Update documentation about version specifiers --- doc/asdf.texinfo | 122 +++++++++++++++++++++++++++++++++++------------ 1 file changed, 92 insertions(+), 30 deletions(-) diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index b9dc5496..15a9a77e 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -1195,7 +1195,8 @@ especially if you intend your software to be eventually included in Quicklisp. @c move it! @item Make sure you know how the @code{:version} numbers will be parsed! -Only period-separated non-negative integers are accepted at present. +By default, ASDF accepts a semver-like string, but this may be changed +through the use of a different system class. @xref{Version specifiers}. @item @@ -1772,14 +1773,57 @@ be forced upon you if you were specifying a string. @cindex :version @anchor{Version specifiers} -Version specifiers are strings to be parsed as period-separated lists of integers. -I.e., in the example, @code{"0.2.1"} is to be interpreted, -roughly speaking, as @code{(0 2 1)}. -In particular, version @code{"0.2.1"} is interpreted the same as @code{"0.0002.1"}, -though the latter is not canonical and may lead to a warning being issued. -Also, @code{"1.3"} and @code{"1.4"} are both strictly @code{uiop:version<} to @code{"1.30"}, -quite unlike what would have happened -had the version strings been interpreted as decimal fractions. +Version specifiers are strings that are parsed in three segments. The +first segment is the core version number and must be a period-separated +list of integers. The second segment is the pre-release segment. It is +separated from the first segment by a @code{#\-} character and must be a +period-separated list of identifiers. Each identifier consists of +alphanumeric characters and the @code{#\-} character. The third segment +is the build metadata segment. It is separated from the other segments +by a @code{#\+} character and must be a period separated list of +identifiers. + +For example, the version specifier @code{"0.2.1-rc.1+git.01234567"} is +to be interpreted as the core version @code{(0 2 1)}, pre-release +@code{("rc" 1)}, and build @code{("git" "01234567")}. Leading zeros from +numeric identifiers in the core and pre-release segments are +stripped. So @code{"0.2.1-rc.1+git.01234567"} is interpreted the same as +@code{"0.0002.1-rc.01+git.01234567"}, though the latter is not canonical +and may lead to a warning being issued. Build metadata is not used at +all for version comparisons, so every identifier is parsed as a string, +even if it consists entirely of numeric characters. + +@code{uiop:version<} is used to order versions. When two versions +@code{x} and @code{y} are ordered, the following rules are observed: + +@enumerate + +@item +If the core segments of @code{x} and @code{y} are not equal, they are +ordered lexicographically. + +@item +If the core segments of @code{x} and @code{y} are equal and @code{y} has +no pre-release segment, but @code{x} does, then @code{x} is +@code{uiop:version<} than @code{y}. + +@item +If the core segments of @code{x} and @code{y} are equal and both have +pre-release segments, then the pre-release segments are compared +lexicographically. When comparing two identifiers that are both +integers, @code{<} is used. When comparing two identifiers that are both +strings, @code{string<} is used. Otherwise, integers are considered +@code{<} strings. + +@item +Build metadata is ignored. + +@end enumerate + +The grammar and ordering rules are adopted from +@url{https://semver.org/spec/v2.0.0.html,Semver v2.0.0}, with the +modification that the core version segment is not limited to exactly +three integers. Instead of a string representing the version, the @code{:version} argument can be an expression that is resolved to @@ -3365,29 +3409,47 @@ ASDF provides built-in methods for @var{version} being a @code{component} or @co @var{version-spec} should be a string. If it's a component, its version is extracted as a string before further processing. -A version string satisfies the version-spec if after parsing, -the former is no older than the latter. -Therefore @code{"1.9.1"}, @code{"1.9.2"} and @code{"1.10"} all satisfy @code{"1.9.1"}, -but @code{"1.8.4"} or @code{"1.9"} do not. -For more information about how @code{version-satisfies} parses and interprets -version strings and specifications, -@pxref{Version specifiers} and +A version string satisfies the version-spec if after parsing, the former +is no older than the latter. Additionally, if @code{version-spec} has no +pre-release segment, then any pre-release segment of @code{version} is +ignored as well. Therefore @code{"1.9.1"}, @code{"1.9.1-0"}, +@code{"1.9.2"}, @code{"1.10"}, and @code{"2.0.0"} all satisfy +@code{"1.9.1"}, but @code{"1.8.4"} or @code{"1.9.0"} do +not. Additionally, @code{"1.9.1"} and @code{"1.9.1-rc.1"} all satisfy +@code{"1.9.1-beta"}, but @code{"1.9.1-alpha"} does not. For more +information about how @code{version-satisfies} parses and interprets +version strings and specifications, @pxref{Version specifiers} and @ref{Common attributes of components}. -Note that in versions of ASDF prior to 3.0.1, -including the entire ASDF 1 and ASDF 2 series, -@code{version-satisfies} would also require that the version and the version-spec -have the same major version number (the first integer in the list); -if the major version differed, the version would be considered as not matching the spec. -But that feature was not documented, therefore presumably not relied upon, -whereas it was a nuisance to several users. -Starting with ASDF 3.0.1, -@code{version-satisfies} does not treat the major version number specially, -and returns T simply if the first argument designates a version that isn't older -than the one specified as a second argument. -If needs be, the @code{(:version ...)} syntax for specifying dependencies -could be in the future extended to specify an exclusive upper bound for compatible versions -as well as an inclusive lower bound. +This behavior may be surprising to users of version strings from other +languages where the default version constraints (such as Node's +@code{^1.9.1} or Python's @code{~=1.9}) enforce that major versions +match and pre-release versions do not satisfy the constraints.@footnote{ +We desire to point out here that the Semver specification makes no +mention of version constraint operators and, at the time of writing, +formalizing such operators continues to be a +@url{https://github.com/semver/semver/pull/584,hotly debated topic} +} +However, we believe that our choices to eschew these traditions from +other language's build systems is best for the CL community. + +In versions of ASDF prior to 3.0.1, including the entire ASDF 1 and ASDF +2 series, @code{version-satisfies} would also require that the version +and the version-spec have the same major version number (the first +integer in the list); if the major version differed, the version would +be considered as not matching the spec. But that feature was not +documented, therefore presumably not relied upon, whereas it was a +nuisance to several users. Additionally, the level of compile time +introspection that Common Lisp provides means that code may easily be +compatible with multiple major versions of its dependencies. + +We allow pre-release versions to satisfy the constraints largely out of +separation of concerns. ASDF is not responsible for fetching +dependencies and we feel the decision on whether or not to use +pre-release versions is best made there. If you choose to make +pre-releases visible to ASDF, presumably you know that things could +break horribly as the code could change drastically before it is fully +released. @end defun @node Parsing system definitions, , Functions, The object model of ASDF -- GitLab From ab9e3e8265e02c8f365c75d396fdca1af457fba0 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 18 Apr 2021 16:53:20 -0400 Subject: [PATCH 08/49] Make VERSION-SATISFIES actually follow the documentation --- component.lisp | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/component.lisp b/component.lisp index ee2100d1..e6672380 100644 --- a/component.lisp +++ b/component.lisp @@ -354,10 +354,16 @@ this compilation, or check its results, etc.")) (when version (warn "Requested version ~S but ~S has no version" version c)) (return-from version-satisfies nil)) - (version-satisfies (component-version c) version)) + (version-satisfies (nth-value 1 (component-version c)) version)) (defmethod version-satisfies ((cver string) version) - (version<= version cver))) + (if (nth-value 1 (parse-version version)) + ;; The required VERSION has a pre-release segment, do not ignore + ;; pre-release segments in CVER. + (version<= version cver) + ;; No pre-release segment on VERSION. Ignore any pre-release + ;; information in CVER. + (version<= version (parse-version cver))))) ;;; all sub-components (of a given type) -- GitLab From 3fb42e21d89a790e16a193d82178c13984e64052 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 18 Apr 2021 17:01:37 -0400 Subject: [PATCH 09/49] Add version constraints to manual --- doc/asdf.texinfo | 83 +++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 82 insertions(+), 1 deletion(-) diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index 15a9a77e..a618136c 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -1231,6 +1231,7 @@ slightly convoluted example: (defsystem "foo" :version (:read-file-form "variables" :at (3 2)) + :compatible-versions (:>= "1") :components ((:file "package") (:file "variables" :depends-on ("package")) @@ -1409,6 +1410,13 @@ We recommend you either prefix use of UIOP functions with the package prefix @co or make sure your system @code{:depends-on ((:version "asdf" "3.1.2"))} or has a @code{#-asdf3.1 (error "MY-SYSTEM requires ASDF 3.1.2")}. +@item +Starting with ASDF 3.4, you can specify how backwards compatible you +expect your system to be using the @code{:compatible-versions} +argument. In this example, this version of @code{foo} should satisfy any +system that expects @code{foo} to be between versions 1 and the current +version. + @item Finally, we elided most metadata, but showed how you can have ASDF automatically extract the system's version from a source file. In this case, the 3rd subform of the 4th form @@ -1479,6 +1487,8 @@ Presumably, the 4th form looks like @code{(defparameter *foo-version* "5.6.7")}. | :source-control @refrule{source-control} | :version @refrule{version-specifier} | :entry-point @var{object} # @pxref{Entry point} + # This is only available since ASDF 3.4 + | :compatible-versions @refrule{version-constraint} @defrule{source-control} ( @var{keyword} @var{string} ) @@ -1515,7 +1525,7 @@ Presumably, the 4th form looks like @code{(defparameter *foo-version* "5.6.7")}. # in :in-order-to @defrule{dependency-def} @refrule{simple-component-name} | ( :feature @refrule{feature-expression} @refrule{dependency-def} ) # @pxref{Feature dependencies} - | ( :version @refrule{simple-component-name} @refrule{version-specifier} ) + | ( :version @refrule{simple-component-name} @refrule{version-constraint} ) | ( :require @var{module-name} ) # "dependency" is used in :in-order-to, as opposed to "dependency-def" @@ -1534,6 +1544,16 @@ Presumably, the 4th form looks like @code{(defparameter *foo-version* "5.6.7")}. @defrule{line-specifier} :at @var{integer} # base zero @defrule{form-specifier} :at [ @var{integer} | ( @var{integer}+ ) ] +@defrule{version-constraint} @refrule{compound-version-constraint} + | @refrule{compatibility-version-constraint} + | @refrule{simple-version-constraint} +@defrule{compound-version-constraint} ( :and @refrule{version-constraint} ) + | ( :or @refrule{version-constraint} ) +@defrule{compatibility-version-constraint} ( :compatible @var{string} ) | @var{string} +@defrule{simple-version-constraint} ( :> @var{string} ) | ( :>= @var{string} ) + | ( :< @var{string} ) | ( :<= @var{string} ) + | ( := @var{string} ) | ( :/= @var{string} ) + @defrule{method-form} ( @refrule{operation-name} @refrule{qual} @var{lambda-list} @Arest{} @var{body} ) @defrule{qual} @refrule{method-qualifier}? @defrule{method-qualifier} :before | :after | :around @@ -1850,6 +1870,67 @@ where significant API incompatibilities are signaled by an increased major numbe @xref{Common attributes of components}. +@subsection Version constraints +@cindex version constraints +@cindex :compatible-versions +@anchor{Version constraints} + +ASDF allows systems to specify constraints on the allowed version of +their dependencies. Additionally, systems can specify which of their own +versions they are API compatible with. Both of these are specified using +version constraints. Be aware that ASDF simply evaluates these +constraints and signals an error if they are not met. It is up to you or +your package management system to ensure that compatible versions of +systems are installed and discoverable by ASDF. + +To specify a constraint on the version of dependency @code{foo}, simply +add something like the following to your @code{:depends-on} list: +@code{(:version "foo" (:and "1.2" (:/= "1.4.0")))}. This constraint says +that any version of @code{foo} is allowed, so long as it is +``compatible'' with version 1.2 (discussed more below) and is not equal +to 1.4.0. + +By default a compatibility constraint is equivalent to specifying the +minimum version of a system. However, a system can provide its own +defintion of what compatibility means to it via the +@code{:compatible-versions} argument to @code{defsystem}. Version +@var{x} of a system is considered compatible with version @var{y} of +itself if both @var{x} is greater than or equal to @var{y} and @var{y} +satisfies version @var{x}'s @code{:compatible-versions} constraint, if +any. + +Consider the three following examples of system @code{foo}. The first +two satisfy the previous dependency constraint, but the third does not. + +@lisp +(defsystem "foo" + :version "1.3.0" + ...) + +(defsystem "foo" + :version "2.0.0" + ...) + +(defsystem "foo" + :version "3.0.0" + :compatible-versions (:>= "3") + ...) +@end lisp + +Common Lisp allows for a great deal of introspection at run and compile +time. As such, it is very possible that your system can handle any +version of @code{foo}, even if @code{foo}'s author believes them to be +incompatible under normal circumstances. If that is the case, simply use +the @code{:or} operator. All three definitions of @code{foo} satisfy +this constraint: @code{(:version "foo" (:and (:or "1.2" "3.0") (:/= "1.4.0")))}. + +While the version constraint language allows you to disallow versions of +a dependency that are yet unrelasesed, it is extremely bad form to do +so. When specifying a constraint on a dependency, you should avoid the +@code{:<} and @code{:<=} operators. Instead you should use @code{:/=} to +knock out known bad versions and otherwise leave it up to the author of +your dependency to declare known incompatibilities. + @subsection Require @cindex :require dependencies -- GitLab From b652864c14792553487a8bf590e29d711de2d64e Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 18 Apr 2021 22:42:03 -0400 Subject: [PATCH 10/49] Fix bug in VERSION-SATISFIES --- component.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/component.lisp b/component.lisp index e6672380..432f2320 100644 --- a/component.lisp +++ b/component.lisp @@ -363,7 +363,7 @@ this compilation, or check its results, etc.")) (version<= version cver) ;; No pre-release segment on VERSION. Ignore any pre-release ;; information in CVER. - (version<= version (parse-version cver))))) + (version<= version (unparse-version (parse-version cver)))))) ;;; all sub-components (of a given type) -- GitLab From 5c8d325269072c31c2f5a62860a06ba02a72a660 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 18 Apr 2021 22:42:17 -0400 Subject: [PATCH 11/49] Remove a return value that was used for debugging --- uiop/version.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/uiop/version.lisp b/uiop/version.lisp index 5273ddd7..b254f2b5 100644 --- a/uiop/version.lisp +++ b/uiop/version.lisp @@ -117,7 +117,7 @@ but the values are returned anyway." (normalized-version (unparse-version core-segment pre-release-segment build-segment))) (unless (equal version-string normalized-version) (call-function on-error "~S: ~S contains leading zeros" 'parse-version version-string)) - (values core-segment pre-release-segment build-segment normalized-version)))))) + (values core-segment pre-release-segment build-segment)))))) (defun next-version (version) "When VERSION is not nil, it is a string, then parse it as a version, compute the next version -- GitLab From 02e785a5c4f0496e0d1f42627b91f265b350ecf3 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Mon, 19 Apr 2021 08:03:23 -0400 Subject: [PATCH 12/49] Make CCL happy about an unused variable --- component.lisp | 1 + 1 file changed, 1 insertion(+) diff --git a/component.lisp b/component.lisp index 432f2320..e08ffbe0 100644 --- a/component.lisp +++ b/component.lisp @@ -196,6 +196,7 @@ dot-separated natural numbers." (values-list next-values)))) (defmethod (setf component-version) :around (value (component component)) + (declare (ignore value)) (let ((next-values (multiple-value-list (call-next-method)))) (if (and (first next-values) (null (second next-values))) (component-version component) -- GitLab From a406f214091a08bd9fbf386983584759ac5c8480 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Mon, 19 Apr 2021 08:28:16 -0400 Subject: [PATCH 13/49] Ensure (setf component-version) returns original version if unchanged --- component.lisp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/component.lisp b/component.lisp index e08ffbe0..06949f8e 100644 --- a/component.lisp +++ b/component.lisp @@ -185,7 +185,8 @@ dot-separated natural numbers." (if-let (core-segment (parse-version value)) (let ((core-string (unparse-version core-segment))) (setf (slot-value component 'version) (list core-string value)) - (values core-string value))))) + (values core-string value)) + (component-version component)))) ;; Adapt any existing implementation of COMPONENT-VERSION to the new ;; interface. -- GitLab From 589dae0cde1d02b4c86b8231e5dacf1b5b8f0a3d Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Mon, 19 Apr 2021 08:28:42 -0400 Subject: [PATCH 14/49] Add VERSION-CORE-STRING Better abstraction to extract just the core part of the string then (unparse-version (parse-version version)). --- component.lisp | 2 +- uiop/version.lisp | 7 +++++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/component.lisp b/component.lisp index 06949f8e..76dca225 100644 --- a/component.lisp +++ b/component.lisp @@ -365,7 +365,7 @@ this compilation, or check its results, etc.")) (version<= version cver) ;; No pre-release segment on VERSION. Ignore any pre-release ;; information in CVER. - (version<= version (unparse-version (parse-version cver)))))) + (version<= version (version-core-string cver))))) ;;; all sub-components (of a given type) diff --git a/uiop/version.lisp b/uiop/version.lisp index b254f2b5..e8a9d546 100644 --- a/uiop/version.lisp +++ b/uiop/version.lisp @@ -4,6 +4,7 @@ (:export #:*uiop-version* #:parse-version #:unparse-version #:version< #:version<= #:version= ;; version support, moved from uiop/utility + #:version-core-string #:next-version #:deprecated-function-condition #:deprecated-function-name ;; deprecation control #:deprecated-function-style-warning #:deprecated-function-warning @@ -119,6 +120,12 @@ but the values are returned anyway." (call-function on-error "~S: ~S contains leading zeros" 'parse-version version-string)) (values core-segment pre-release-segment build-segment)))))) + (defun version-core-string (version) + "When VERSION is not NIL, it is a string, then parse it as a version, +return the string corresponding to the core segment of VERSION." + (when version + (unparse-version (parse-version version)))) + (defun next-version (version) "When VERSION is not nil, it is a string, then parse it as a version, compute the next version and return it as a string." -- GitLab From ee2c28a717d219c9ec407fdf6ad77840e1e5112d Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Mon, 22 Nov 2021 22:03:20 -0500 Subject: [PATCH 15/49] Cleanup manual discussion of version specifiers and constraints --- doc/asdf.texinfo | 626 ++++++++++++++++++++++++++++++++++++----------- 1 file changed, 485 insertions(+), 141 deletions(-) diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index a618136c..587c5261 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -96,6 +96,7 @@ Manual for Version 3.3.5.7 * Using ASDF:: * Defining systems with defsystem:: * The object model of ASDF:: +* Version specifiers and ASDF:: * Controlling where ASDF searches for systems:: * Controlling where ASDF saves compiled files:: * Error handling:: @@ -146,9 +147,15 @@ The Object model of ASDF * Operations:: * Components:: * Dependencies:: -* Functions:: * Parsing system definitions:: +Version specifiers and ASDF + +* Introduction to Versions:: +* The Many Hats of a Programmer:: +* Version Specifier Parsing:: +* Version Constraints:: + Operations * Predefined operations of ASDF:: @@ -1194,10 +1201,11 @@ especially if you intend your software to be eventually included in Quicklisp. @c FIXME: this is way too detailed for the first example! @c move it! @item -Make sure you know how the @code{:version} numbers will be parsed! -By default, ASDF accepts a semver-like string, but this may be changed -through the use of a different system class. -@xref{Version specifiers}. +Make sure you know how the @code{:version} numbers will be parsed! By +default, ASDF accepts a string containing period-separated +non-negative integers and pre-release information separated by a +hyphen. However, this may be changed through the use of a different +system or version class. @xref{Version specifiers}. @item This file contains a single form, the @code{defsystem} declaration. @@ -1487,8 +1495,9 @@ Presumably, the 4th form looks like @code{(defparameter *foo-version* "5.6.7")}. | :source-control @refrule{source-control} | :version @refrule{version-specifier} | :entry-point @var{object} # @pxref{Entry point} - # This is only available since ASDF 3.4 + # These are only available since ASDF 3.4 | :compatible-versions @refrule{version-constraint} + | :version-class @var{class-name} # @pxref{Version class} @defrule{source-control} ( @var{keyword} @var{string} ) @@ -1788,62 +1797,57 @@ fulfills whatever constraints are required from that component type on the other hand, you can circumvent the file type that would otherwise be forced upon you if you were specifying a string. +@subsection Version class +@cindex version class +@cindex :version-class +@anchor{Version class} + +A version class name will be looked up the same way as a component +type (see above), except that only subclasses of @code{uiop:version} +are allowed. Typically, one will not need to specify a version class +name, unless they want to customize their version specifier. + @subsection Version specifiers @cindex version specifiers @cindex :version @anchor{Version specifiers} -Version specifiers are strings that are parsed in three segments. The -first segment is the core version number and must be a period-separated -list of integers. The second segment is the pre-release segment. It is -separated from the first segment by a @code{#\-} character and must be a -period-separated list of identifiers. Each identifier consists of -alphanumeric characters and the @code{#\-} character. The third segment -is the build metadata segment. It is separated from the other segments -by a @code{#\+} character and must be a period separated list of -identifiers. - -For example, the version specifier @code{"0.2.1-rc.1+git.01234567"} is -to be interpreted as the core version @code{(0 2 1)}, pre-release -@code{("rc" 1)}, and build @code{("git" "01234567")}. Leading zeros from -numeric identifiers in the core and pre-release segments are -stripped. So @code{"0.2.1-rc.1+git.01234567"} is interpreted the same as -@code{"0.0002.1-rc.01+git.01234567"}, though the latter is not canonical -and may lead to a warning being issued. Build metadata is not used at -all for version comparisons, so every identifier is parsed as a string, -even if it consists entirely of numeric characters. - -@code{uiop:version<} is used to order versions. When two versions -@code{x} and @code{y} are ordered, the following rules are observed: +A version specifier is a string that can be parsed to make an object +that is a subclass of @code{uiop:version}. The default version class, +@code{uiop:default-version} accepts strings that are parsed in two +segments. + +The first segment denotes the ``core'' version number. It is required +and must consist of any number of non-negative integers, separated by +@code{#\.} characters. + +The second segment is optional and contains pre-release +information. If present, the pre-release segment must be separated +from the first by a @code{#\-} character. This segment consists of a +``category'' (@code{alpha}, @code{beta}, or @code{rc}), optionally +followed by @code{#\.} character and a non-negative integer. + +Examples of valid specifiers include: @enumerate @item -If the core segments of @code{x} and @code{y} are not equal, they are -ordered lexicographically. +@code{1.2.0} - The released 1.2.0. @item -If the core segments of @code{x} and @code{y} are equal and @code{y} has -no pre-release segment, but @code{x} does, then @code{x} is -@code{uiop:version<} than @code{y}. +@code{1.3.0-alpha.4} - The fourth alpha release of 1.3.0. @item -If the core segments of @code{x} and @code{y} are equal and both have -pre-release segments, then the pre-release segments are compared -lexicographically. When comparing two identifiers that are both -integers, @code{<} is used. When comparing two identifiers that are both -strings, @code{string<} is used. Otherwise, integers are considered -@code{<} strings. +@code{1.3.0-rc} - A release candidate of 1.3.0. @item -Build metadata is ignored. +@code{1.3.0} - The released 1.3.0. @end enumerate -The grammar and ordering rules are adopted from -@url{https://semver.org/spec/v2.0.0.html,Semver v2.0.0}, with the -modification that the core version segment is not limited to exactly -three integers. +@code{uiop:version<} is used to order versions. The above list of +versions is ordered as @code{uiop:version<} would order them. For more +details on the default ordering rules, @pxref{Version specifiers and ASDF}. Instead of a string representing the version, the @code{:version} argument can be an expression that is resolved to @@ -1863,7 +1867,7 @@ subforms can also be specified, with e.g. @code{(1 2 2)} specifying ``the third subform (index 2) of the third subform (index 2) of the second form (index 1)'' in the file (mind the off-by-one error in the English language). -System definers are encouraged to use version identifiers of the form +System implementors are encouraged to use version identifiers of the form @var{x}.@var{y}.@var{z} for major version, minor version and patch level, where significant API incompatibilities are signaled by an increased major number. @@ -1876,31 +1880,33 @@ where significant API incompatibilities are signaled by an increased major numbe @anchor{Version constraints} ASDF allows systems to specify constraints on the allowed version of -their dependencies. Additionally, systems can specify which of their own -versions they are API compatible with. Both of these are specified using -version constraints. Be aware that ASDF simply evaluates these -constraints and signals an error if they are not met. It is up to you or -your package management system to ensure that compatible versions of -systems are installed and discoverable by ASDF. - -To specify a constraint on the version of dependency @code{foo}, simply -add something like the following to your @code{:depends-on} list: -@code{(:version "foo" (:and "1.2" (:/= "1.4.0")))}. This constraint says -that any version of @code{foo} is allowed, so long as it is -``compatible'' with version 1.2 (discussed more below) and is not equal -to 1.4.0. - -By default a compatibility constraint is equivalent to specifying the -minimum version of a system. However, a system can provide its own -defintion of what compatibility means to it via the -@code{:compatible-versions} argument to @code{defsystem}. Version -@var{x} of a system is considered compatible with version @var{y} of -itself if both @var{x} is greater than or equal to @var{y} and @var{y} -satisfies version @var{x}'s @code{:compatible-versions} constraint, if -any. - -Consider the three following examples of system @code{foo}. The first -two satisfy the previous dependency constraint, but the third does not. +their dependencies. Additionally, systems can specify which of their +own previous versions they are API compatible with. Both of these are +specified using version constraints. Be aware that ASDF simply +evaluates these constraints and signals a continuable error if they +are not met. It is up to you or your package management system to +ensure that compatible versions of systems are installed and +discoverable by ASDF. + +We @emph{strongly} recommend reading the chapter on version specifiers +and ASDF before using version constraints in your +systems. @xref{Version specifiers and ASDF}. + +A simple version constraint consists of an operator followed by a +version specifier (string). The allowed operators are @code{:>=}, +@code{:>}, @code{:<=}, @code{:<}, @code{:=}, and @code{:/=}. + +ASDF also includes a ``compatibility'' constraint. This constraint is +specified using either the @code{:compatible} operator or a raw +version specifier string. A compatibility specifies a minimum version +(similar to the @code{:>=} operator, but additionally respects the +depended on system's @code{:compatible-versions} argument. + +Last, the previous constraints can be composed together as a compound +version constraint, using the @code{:and} or @code{:or} operators. + +As an example, consider the three following examples of system +@code{foo}. @lisp (defsystem "foo" @@ -1917,19 +1923,29 @@ two satisfy the previous dependency constraint, but the third does not. ...) @end lisp -Common Lisp allows for a great deal of introspection at run and compile -time. As such, it is very possible that your system can handle any -version of @code{foo}, even if @code{foo}'s author believes them to be -incompatible under normal circumstances. If that is the case, simply use -the @code{:or} operator. All three definitions of @code{foo} satisfy -this constraint: @code{(:version "foo" (:and (:or "1.2" "3.0") (:/= "1.4.0")))}. -While the version constraint language allows you to disallow versions of -a dependency that are yet unrelasesed, it is extremely bad form to do -so. When specifying a constraint on a dependency, you should avoid the -@code{:<} and @code{:<=} operators. Instead you should use @code{:/=} to -knock out known bad versions and otherwise leave it up to the author of -your dependency to declare known incompatibilities. +The first two satisfy the dependency constraint +@code{(:version "foo" (:and "1.2" (:/= "1.4.0")))}, but the third does +not. Note that the third does not satisfy the constraint because +@code{foo}'s author believes the API has changed enough in version +@code{3.0.0} that any system written for a previous version will not +work as-is. + +However, Common Lisp allows for a great deal of introspection at run +and compile time. As such, it is very possible that your system can +handle any version of @code{foo}, even if @code{foo}'s author believes +them to be incompatible under normal circumstances. If that is the +case, simply use the @code{:or} operator. All three definitions of +@code{foo} satisfy this constraint: +@code{(:version "foo" (:and (:or "1.2" "3.0") (:/= "1.4.0")))}. + +While the version constraint language allows you to disallow versions +of a dependency that are not yet released, it is extremely bad form to +do so. When specifying a constraint on a dependency, you should avoid +the @code{:<} and @code{:<=} operators. Instead you should use +@code{:/=} to knock out known bad versions and otherwise leave it up +to the author of your dependency to declare known incompatibilities. + @subsection Require @cindex :require dependencies @@ -2321,7 +2337,7 @@ where the @file{.asd} file resides. @codequoteundirected off -@node The object model of ASDF, Controlling where ASDF searches for systems, Defining systems with defsystem, Top +@node The object model of ASDF, Version specifiers and ASDF, Defining systems with defsystem, Top @comment node-name, next, previous, up @chapter The Object model of ASDF @tindex component @@ -2386,7 +2402,6 @@ customize the behaviour of existing @emph{functions}. * Operations:: * Components:: * Dependencies:: -* Functions:: * Parsing system definitions:: @end menu @@ -3444,7 +3459,7 @@ The new component type is used in a @code{defsystem} form in this way: ) @end lisp -@node Dependencies, Functions, Components, The object model of ASDF +@node Dependencies, Parsing system definitions, Components, The object model of ASDF @section Dependencies @c FIXME: Moved this material here, but it isn't very comfortable @c here.... Also needs to be revised to be coherent. @@ -3479,61 +3494,7 @@ remain at the system level, and are not propagated along the hierarchy, but instead do something global on the system. -@node Functions, Parsing system definitions, Dependencies, The object model of ASDF -@comment node-name, next, previous, up -@section Functions - -@c FIXME: this does not belong here.... -@defun version-satisfies @var{version} @var{version-spec} -Does @var{version} satisfy the @var{version-spec}. A generic function. -ASDF provides built-in methods for @var{version} being a @code{component} or @code{string}. -@var{version-spec} should be a string. -If it's a component, its version is extracted as a string before further processing. - -A version string satisfies the version-spec if after parsing, the former -is no older than the latter. Additionally, if @code{version-spec} has no -pre-release segment, then any pre-release segment of @code{version} is -ignored as well. Therefore @code{"1.9.1"}, @code{"1.9.1-0"}, -@code{"1.9.2"}, @code{"1.10"}, and @code{"2.0.0"} all satisfy -@code{"1.9.1"}, but @code{"1.8.4"} or @code{"1.9.0"} do -not. Additionally, @code{"1.9.1"} and @code{"1.9.1-rc.1"} all satisfy -@code{"1.9.1-beta"}, but @code{"1.9.1-alpha"} does not. For more -information about how @code{version-satisfies} parses and interprets -version strings and specifications, @pxref{Version specifiers} and -@ref{Common attributes of components}. - -This behavior may be surprising to users of version strings from other -languages where the default version constraints (such as Node's -@code{^1.9.1} or Python's @code{~=1.9}) enforce that major versions -match and pre-release versions do not satisfy the constraints.@footnote{ -We desire to point out here that the Semver specification makes no -mention of version constraint operators and, at the time of writing, -formalizing such operators continues to be a -@url{https://github.com/semver/semver/pull/584,hotly debated topic} -} -However, we believe that our choices to eschew these traditions from -other language's build systems is best for the CL community. - -In versions of ASDF prior to 3.0.1, including the entire ASDF 1 and ASDF -2 series, @code{version-satisfies} would also require that the version -and the version-spec have the same major version number (the first -integer in the list); if the major version differed, the version would -be considered as not matching the spec. But that feature was not -documented, therefore presumably not relied upon, whereas it was a -nuisance to several users. Additionally, the level of compile time -introspection that Common Lisp provides means that code may easily be -compatible with multiple major versions of its dependencies. - -We allow pre-release versions to satisfy the constraints largely out of -separation of concerns. ASDF is not responsible for fetching -dependencies and we feel the decision on whether or not to use -pre-release versions is best made there. If you choose to make -pre-releases visible to ASDF, presumably you know that things could -break horribly as the code could change drastically before it is fully -released. -@end defun - -@node Parsing system definitions, , Functions, The object model of ASDF +@node Parsing system definitions, , Dependencies, The object model of ASDF @section Parsing system definitions @cindex Parsing system definitions @cindex Extending ASDF's defsystem parser @@ -3588,8 +3549,391 @@ for) new component types. @end deffn +@node Version specifiers and ASDF, Controlling where ASDF searches for systems, The object model of ASDF, Top +@comment node-name, next, previous, up +@chapter Version specifiers and ASDF + +@menu +* Introduction to Versions:: +* The Many Hats of a Programmer:: +* Version Specifier Parsing:: +* Version Constraints:: +@end menu + +@node Introduction to Versions, The Many Hats of a Programmer, Version specifiers and ASDF, Version specifiers and ASDF +@section Introduction to Versions + +Version specifiers are an imprecise, yet concise and widely used way +to summarize what the features and API are of a library. Like any good +build system, ASDF allows systems to provide their version, depend on +specific versions of their dependencies, and advertise when API +breakage occurs. However, unlike many extant build systems, ASDF +allows its version grammar to be extended and chooses slightly +different defaults that are more in line with how the Common Lisp +community operates (especially when paired with the stability of the +language!). + +In this chapter, we describe the different considerations that a +programmer must keep in mind when they are versioning their systems, +using versioned systems, or assembling a complete development (or +production, etc.) environment. We then continue be describing ASDF's +API for specifying versions and the API for specifying version +constraints. + +@node The Many Hats of a Programmer, Version Specifier Parsing, Introduction to Versions, Version specifiers and ASDF +@section The Many Hats of a Programmer + +@menu +* The Implementor Hat:: +* The Consumer Hat:: +* The Integrator Hat:: +@end menu + +There are (at least) three hats that a programmer must wear when +thinking about versions and version constraints: implementor, +consumer, and integrator. In each role, the programmer has different +considerations they must keep in mind. + +@node The Implementor Hat, The Consumer Hat, The Many Hats of a Programmer, The Many Hats of a Programmer +@subsection The Implementor Hat + +When a programmer is writing a system for others to use, they must +wear their implementor hat. The goal of an implementor is to concisely +communicate a feature (and bug!) set to those that depend on their +system. Additionally, an implementor must communicate how backward +compatible each version is. + +In order to communicate a feature set, we encourage all implementors +to provide version numbers for each of their systems. Additionally, +implementors should maintain a change log that a consumer can use to +see what features were added, changed, or removed in each release. + +In order to communicate how backward compatible each release is, we +encourage implementors to both communicate a general policy to their +users and use the @code{:compatible-versions} argument to +@code{defsystem} to declaratively state when the last ``breaking'' +change was. + +A good implementor always has backward compatibility on their mind and +seeks to maintain it. As such, we recommend that implementors adopt +one of the following policies, with the policies listed from most to +least preferable. + +@enumerate + +@item +Once your system has been released for others to use, never break +backward compatibility. One way to accomplish this in Common Lisp is +to version your package names. For example, release v1.0 of system +@code{foo} could provide the @code{foo-v1} package. If @code{foo}'s +author then realizes that exported functions are not particularly easy +to use, they can release @code{foo} v2 that provides both the +@code{foo-v1} @emph{and} @code{foo-v2} packages. Where @code{foo-v1} +exports the same API as it did in @code{foo} v1.0, but all of its +functions have been rewritten to call functionality exported by the +@code{foo-v2} package. + +@item +If an update would break an API, create an entirely new system (and +potentially an entirely new project) for the new version. The old +system can remain frozen and usable while other systems slowly move +over to your new system name. + +@item +Introduce the new API and have it coexist with the old API for a +period of time. Document the old API as deprecated. Work with all of +your consumers to move over to your new API. After a reasonable amount +of time, remove the old API, increment the version number, and update +your system's @code{:compatible-versions} constraint. + +@end enumerate + +@node The Consumer Hat, The Integrator Hat, The Implementor Hat, The Many Hats of a Programmer +@subsection The Consumer Hat + +When a programmer is declaring a dependency on another system, they +must wear their consumer hat. The goal of a consumer is to communicate +what feature set and API they need from their dependency. + +Typically, this is communicated by declaring a minimum version of the +dependency that is required. However, a consumer may also specify +upper bounds or state that specific versions of a dependency are not +to be allowed. + +A good consumer must try and ensure that they do not artificially +constrain which versions of their dependencies are allowed. Therefore, +we recommend that consumers only use the ``compatibility'' +constraint. This both declares a minimum version and tells ASDF to +respect the dependency's @code{:compatible-versions} argument. + +If a consumer's dependency does introduce a breaking change but the +consumer uses reader macros or other introspection capabilities to +remain compatible with releases before and after the breaking change, +the consumer may use the @code{:or} operator to combine compatibility +constraints. For example, the constraint +@code{(:version "foo" (:or "1" "2"))} states that the consumer can use +version 1 or 2 of @code{foo}, even if v2 introduced a breaking change. + +We @emph{strongly} recommend that consumers do not use the @code{:<}, +@code{:<=}, or @code{:/=} operators when specifying a version +constraint. They should only be used if either you have observed that +the disallowed versions break the consumer @emph{or} you do not trust +your dependency's implementor to use @code{:compatible-versions} +correctly (in which case, we recommend that you do the community a +favor and engage with the implementor to remedy the issue or fork the +project if necessary). + +@node The Integrator Hat, The Consumer Hat, Version Specifier Parsing, The Many Hats of a Programmer +@subsection The Integrator Hat + +The last hat a programmer typically wears is that of an integrator. An +integrator is responsible for assembling and maintaining a complete +environment. This includes not only the direct dependencies of a +system (or systems), but their transitive dependencies as well. + +The most frequent environment that a programmer assembles is the +development and testing environment for one of their systems. However, +this also includes things such as production and quality assurance +environments typically used by large scale application development +processes. + +Typically, an integrator is tasked with creating an environment that +both works (e.g., there are no conflicts between different systems in +the environment) and is reproducible. + +Most of our guidance for implementors and consumers is designed to +make the lives of integrators easier. If implementors make few +breaking changes and consumers state only the bare minimum needed from +their dependencies, then integrators have more flexibility to assemble +a working environment. + +The only tool that ASDF provides which is aimed specifically at +integrators is that all errors resulting from version constraint +violations are continuable. So if you are forced to work with a set of +systems that does not adhere to ASDF's recommendations, you can tell +ASDF to ignore the constraint violation and continue operating +anyways. + +We recommend that integrators look into the features their chosen +Common Lisp dependency manager provides for assembling a working, +coherent, reproducible environment. + +@node Version Specifier Parsing, Version Constraints, Introduction to Versions, Version specifiers and ASDF +@section Version Specifier Parsing + +ASDF's default version specifier parsing methods are designed to parse +a majority of version strings seen in the wild. However, it is fully +extensible so that system implementors may use whichever scheme they +want. + +All version specifiers must parse to an object that is a subclass of +@code{uiop:version}. The default version class is +@code{uiop:default-version}. A system implementor can choose a +non-default class using the @code{:version-class} argument to +@code{defsystem}. + +The value of @code{:version-class} must be a symbol or string naming +the class. If it is a keyword, ASDF attempts to find the class in the +@code{asdf} package. If it is a symbol, it must be the name of the +class. If it is a string, it will be @code{read} after the +@code{:defsystem-depends-on} list have been loaded and must result in +a symbol naming the class to use. + +A custom version class must implement the following interface: + +@deffn {Initarg} :version-string + +The class must accept the @code{:version-string} initarg. This will +be the string the user specified in the @code{defsystem}. + +If the @code{:version-string} is invalid, the class's initialization +methods must signal a @code{uiop:version-string-invalid-error} +condition. ASDF will provide restarts for the user to either enter +another string or treat the version as being unspecified. + +@end deffn + +@deffn {Generic Function} uiop:version-pre-release-p @var{version} + +Returns non-NIL if @code{version} is a pre-release. + +@end deffn + +@deffn {Generic Function} uiop:version-pre-release-for @var{version} + +If @code{uiop:version-pre-release-p} is non-NIL, this must return an +instance of @code{uiop:version} that represents the version for which +@code{version} is a pre-release. + +If the returned version is @code{final-version}, +@code{(uiop:version-pre-release-p final-version)} must be NIL and +@code{(uiop:version< version final-version)} must be non-NIL. + +@end deffn + +@deffn {Generic Function} uiop:version< @var{version-1} @var{version-2} + +Returns non-NIL if @code{version-1} is ordered before +@code{version-2}. + +UIOP provides two default methods, @code{(uiop:version string)} and +@code{(string uiop:version)}. Each parses the string as a version +object (using the equivalent of +@code{(make-instance (class-of version) :version-string string)} and +then calls @code{uiop:version<} again. + +@end deffn + +@deffn {Generic Function} uiop:version-string @var{version} + +Returns a string that represents @code{version}. To be used primarily +for display to a user. The returned string must also be suitable for +the @code{:version-string} initarg. + +@end deffn + +ASDF provides two version classes, @code{semantic-version} and +@code{default-version}. + +@code{semantic-version} implements the grammar and ordering rules from +@url{https://semver.org/spec/v2.0.0.html,Semver v2.0.0}, with the +modification that the core version segment is not limited to exactly +three integers. + +@code{default-version} implements the same grammar and ordering rules +as @code{semantic-version}, but limits the pre-release segment to be +contain only @code{alpha}, @code{beta}, or @code{rc}, optionally +followed by a @code{#\.} character and a non-negative +integer. Currently, @code{default-version} is a subclass of +@code{semantic-version} but this may change in the future. + +@node Version Constraints, Controlling where ASDF searches for systems, Version Specifier Parsing, Version specifiers and ASDF +@section Version Constraints + +Version constraints are used for two purposes. The first is to declare +dependencies as part of the @code{:depends-on} or +@code{:defsystem-depends-on} argument. The second is to declare how +backwards compatible a system is using the @code{:compatible-versions} +argument. + +If a version constraint is not satisfied, a +@code{missing-dependency-of-version} error is signaled. This error is +continuable, so you may choose to ignore it and use the dependency +anyways. + +A simple version constraint is a list of two elements. The first is an +operator and the second is a version designator. + +A compound version constraint is a list of two or more elements. The +first is an operator and the remaining elements are version +constraints. + +Last, there is a compatibility version constraint. This is allowed +only for declaring dependencies and is not legal for use in the +@code{:compatible-versions} argument to @code{defsystem}. A +compatibility constraint is either a list of two elements or a version +designator. If a list, the first element must be @code{:compatible} +and the second must be a version designator. + +The allowed simple constraint operators are @code{:>=}, @code{:>}, +@code{:<=}, @code{:<}, @code{:=}, and @code{:/=}. @code{uiop:version<} +is used to compare versions under the hood. + +For example, assume there is a system @code{foo}, with version +@code{V1}. If system @code{bar} has the dependency +@code{(:version "foo" (:>= VS2)}, where @code{VS2} is some +string. First, @code{VS2} will be parsed as a version object @code{V2} +using @code{foo}'s version class. If parsing fails, the constraint is +not satisfied. Then, if @code{(not (uiop:version< V1 V2))} is true, +the constraint is satisfied. If it is false, the constraint is not +satisfied. + +Compound constraints require that either all sub-constraints are +satisfied (@code{:and}), or at least one of them is (@code{:or}). + +A compatibility constraint is satisfied if the dependency's version is +@code{:>=} the requested version @emph{and} the requested version +satisfies the dependency's @code{:compatible-versions} constraint (if +it is non-NIL). For example, consider @code{foo} is at version +@code{3.0.0} with no @code{:compatible-versions} constraint. That +version of foo will satisfy the constraint @code{(:version "foo" "1.4")}. + +However, if @code{foo} has the @code{:compatible-versions} constraint +@code{(:>= "2")}, it will no longer satisfy the constraint +@code{(:version "foo" "1.4")}. That is because the requested version +(@code{1.4}) is not at least @code{2}. + +Additionally, note that for any simple or compatibility constraint, if +the requested version does not contain pre-release information, then +pre-release information is also stripped from the dependency's version +when comparing. This means that @code{foo} version @code{1.2-alpha.1}, +@emph{does} satisfy the constraint +@code{(:version "foo" "1.2")}. However, it will @emph{not} satisfy +@code{(:version "foo" "1.2-rc.1")}. + +This behavior may be surprising to users of version strings from other +languages where the default version constraints (such as Node's +@code{^1.4.1} or Python's @code{~=1.4}) enforce that major versions +must match and pre-release versions do not satisfy the constraints. +However, we believe that our choice to eschew these traditions from +other language's build systems better fits how the CL community +operates. + +Common Lisp developers tend to take backward compatibility very +seriously. Additionally, the Common Lisp ecosystem provides plenty of +tools to help system implementors maintain backward compatibility +without excessive verbosity or pain. For instance, a system may +provide multiple, versioned packages and recommend that consumers use +package local nicknames to access a particular versioned package. + +Additionally, the default version constraints in other language +ecosystems often require that a system consumer mark a wide swath of +dependency versions as incompatible before those version have even +been released! As no one can accurately predict the future, and given +Common Lisp developers' predilection for backwards compatibility, it +is very likely that a system consumer would declare future systems as +incompatible, even when they're not. + +In light of this, ASDF's approach makes no assumptions about the +meaning of the ``major'' version number. Additionally, as a dependency +implementor is the only one that truly knows if a backwards +compatibility breaking change is going to be released, ASDF's approach +lets them communicate that to their consumers. + +We allow pre-release versions to satisfy the constraints largely out +of separation of concerns. ASDF is not responsible for fetching +dependencies and we feel the decision on whether or not to use +pre-release versions is best made there. If you choose to make +pre-releases visible to ASDF, presumably you know that things could +break horribly as the code could change drastically before it is fully +released. + +The primary entry point to the version constraint checking logic is +@code{version-satisfies}. + +@deffn {Generic Function} version-satisfies @var{version} @var{version-constraint} + +Does @var{version} satisfy the @var{version-spec}. Returns two values, +the first is a boolean. If the first is NIL, the second value contains +a section of the @code{version-constraint} that is not satisfied. + +ASDF provides built-in methods for @var{version} being a @code{component} or @code{string}. +@var{version-constraint} should be a version constraint specified in the version constraint DSL. +If @code{version} is a component, its version is extracted before further processing. + +This function should not need to be specialized. + +In versions of ASDF prior to 3.0.1, including the entire ASDF 1 and +ASDF 2 series, @code{version-satisfies} would also require that the +version and the version-spec have the same major version number (the +first integer in the list); if the major version differed, the version +would be considered as not matching the constraint. But that feature +was not documented, therefore presumably not relied upon, whereas it +was a nuisance to several users. + +@end deffn -@node Controlling where ASDF searches for systems, Controlling where ASDF saves compiled files, The object model of ASDF, Top +@node Controlling where ASDF searches for systems, Controlling where ASDF saves compiled files, Version specifiers and ASDF, Top @comment node-name, next, previous, up @chapter Controlling where ASDF searches for systems -- GitLab From 029c439eb81036a9f088c0399ead69a5568fe5b2 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Mon, 22 Nov 2021 22:12:02 -0500 Subject: [PATCH 16/49] Typos --- doc/asdf.texinfo | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index 587c5261..6950bcd6 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -3576,7 +3576,7 @@ language!). In this chapter, we describe the different considerations that a programmer must keep in mind when they are versioning their systems, using versioned systems, or assembling a complete development (or -production, etc.) environment. We then continue be describing ASDF's +production, etc.) environment. We then continue by describing ASDF's API for specifying versions and the API for specifying version constraints. @@ -3636,8 +3636,8 @@ functions have been rewritten to call functionality exported by the @item If an update would break an API, create an entirely new system (and potentially an entirely new project) for the new version. The old -system can remain frozen and usable while other systems slowly move -over to your new system name. +system can remain frozen and usable while other systems move over to +your new system name. @item Introduce the new API and have it coexist with the old API for a -- GitLab From 780fe7fa2a4b7e13593e91a64d0831282a257953 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Mon, 22 Nov 2021 22:17:57 -0500 Subject: [PATCH 17/49] Add component-version gf to documentation --- doc/asdf.texinfo | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index 6950bcd6..b3ef9f8f 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -3792,6 +3792,16 @@ the @code{:version-string} initarg. @end deffn +@deffn {Generic Function} asdf:component-version @var{component} +Returns the version of @code{component}. Returns two values. + +For backwards compatibility, the first value is the string +representation of the version, or NIL (if no version is specified or +it is invalid). The second value is the object that is a subclass of +@code{uiop:version}. + +@end deffn + ASDF provides two version classes, @code{semantic-version} and @code{default-version}. -- GitLab From b68baaf746accfbc22fdf0c78580da70eaf51dd5 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 13:20:38 -0500 Subject: [PATCH 18/49] CLOSize versions and split version classes into a separate file --- Makefile | 2 +- make-asdf.bat | 2 +- make-asdf.sh | 2 +- uiop/uiop.asd | 3 +- uiop/version-specifier.lisp | 248 ++++++++++++++++++++++++++++++++++++ uiop/version.lisp | 160 +++++------------------ 6 files changed, 283 insertions(+), 134 deletions(-) create mode 100644 uiop/version-specifier.lisp diff --git a/Makefile b/Makefile index 7d621589..cd92991a 100644 --- a/Makefile +++ b/Makefile @@ -94,7 +94,7 @@ DOCKER_IMAGE_ECL_BYTECODES ?= containers.common-lisp.net/cl-docker-images/ecl DOCKER_IMAGE_SBCL ?= containers.common-lisp.net/cl-docker-images/sbcl header_lisp := header.lisp -driver_lisp := uiop/package.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/version.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/lisp-build.lisp uiop/launch-program.lisp uiop/run-program.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/driver.lisp +driver_lisp := uiop/package.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/version-specifier.lisp uiop/version.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/lisp-build.lisp uiop/launch-program.lisp uiop/run-program.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/driver.lisp defsystem_lisp := upgrade.lisp session.lisp component.lisp operation.lisp system.lisp system-registry.lisp action.lisp lisp-action.lisp find-component.lisp forcing.lisp plan.lisp operate.lisp find-system.lisp parse-defsystem.lisp bundle.lisp concatenate-source.lisp package-inferred-system.lisp output-translations.lisp source-registry.lisp backward-internals.lisp backward-interface.lisp interface.lisp user.lisp footer.lisp all_lisp := $(header_lisp) $(driver_lisp) $(defsystem_lisp) diff --git a/make-asdf.bat b/make-asdf.bat index 523fbe71..64233607 100644 --- a/make-asdf.bat +++ b/make-asdf.bat @@ -4,7 +4,7 @@ set here=%~dp0 set header_lisp=header.lisp -set driver_lisp=uiop\package.lisp + uiop\common-lisp.lisp + uiop\utility.lisp + uiop\version.lisp + uiop\os.lisp + uiop\pathname.lisp + uiop\filesystem.lisp + uiop\stream.lisp + uiop\image.lisp + uiop\lisp-build.lisp + uiop\launch-program.lisp + uiop\run-program.lisp + uiop\configuration.lisp + uiop\backward-driver.lisp + uiop\driver.lisp +set driver_lisp=uiop\package.lisp + uiop\common-lisp.lisp + uiop\utility.lisp + uiop\version-specifier.lisp + uiop\version.lisp + uiop\os.lisp + uiop\pathname.lisp + uiop\filesystem.lisp + uiop\stream.lisp + uiop\image.lisp + uiop\lisp-build.lisp + uiop\launch-program.lisp + uiop\run-program.lisp + uiop\configuration.lisp + uiop\backward-driver.lisp + uiop\driver.lisp set defsystem_lisp=upgrade.lisp + session.lisp + component.lisp + operation.lisp + system.lisp + system-registry.lisp + action.lisp + lisp-action.lisp + find-component.lisp + forcing.lisp + plan.lisp + operate.lisp + find-system.lisp + parse-defsystem.lisp + bundle.lisp + concatenate-source.lisp + package-inferred-system.lisp + output-translations.lisp + source-registry.lisp + backward-internals.lisp + backward-interface.lisp + interface.lisp + user.lisp + footer.lisp %~d0 diff --git a/make-asdf.sh b/make-asdf.sh index ec429fd2..38721545 100755 --- a/make-asdf.sh +++ b/make-asdf.sh @@ -5,7 +5,7 @@ here="$(dirname $0)" header_lisp="header.lisp" -driver_lisp="uiop/package.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/version.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/lisp-build.lisp uiop/launch-program.lisp uiop/run-program.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/driver.lisp" +driver_lisp="uiop/package.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/version-specifier.lisp uiop/version.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/lisp-build.lisp uiop/launch-program.lisp uiop/run-program.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/driver.lisp" defsystem_lisp="upgrade.lisp session.lisp component.lisp operation.lisp system.lisp system-registry.lisp action.lisp lisp-action.lisp find-component.lisp forcing.lisp plan.lisp operate.lisp find-system.lisp parse-defsystem.lisp bundle.lisp concatenate-source.lisp package-inferred-system.lisp output-translations.lisp source-registry.lisp backward-internals.lisp backward-interface.lisp interface.lisp user.lisp footer.lisp" all () { diff --git a/uiop/uiop.asd b/uiop/uiop.asd index 72fffb0d..4e4d2720 100644 --- a/uiop/uiop.asd +++ b/uiop/uiop.asd @@ -32,7 +32,8 @@ you already have a matching UIOP loaded." (:file "package") (:file "common-lisp" :depends-on ("package")) (:file "utility" :depends-on ("common-lisp")) - (:file "version" :depends-on ("utility")) + (:file "version-specifier" :depends-on ("utility")) + (:file "version" :depends-on ("version-specifier")) (:file "os" :depends-on ("utility")) (:file "pathname" :depends-on ("utility" "os")) (:file "filesystem" :depends-on ("os" "pathname")) diff --git a/uiop/version-specifier.lisp b/uiop/version-specifier.lisp new file mode 100644 index 00000000..9715943a --- /dev/null +++ b/uiop/version-specifier.lisp @@ -0,0 +1,248 @@ +(uiop/package:define-package :uiop/version-specifier + (:recycle :uiop/version-specifier :uiop/utility :asdf) + (:use :uiop/common-lisp :uiop/package :uiop/utility) + (:export + ;; Basic version API + #:version #:version-string-invalid-error #:version-pre-release-p #:version-pre-release-for + #:version< #:version-string + + ;; Semantic versions + #:semantic-version + + ;; Default versions + #:default-version)) +(in-package :uiop/version-specifier) + +;; Base version class +(with-upgradability () + (defclass version () + () + (:documentation + "The base class of version specifiers.")) + + (define-condition version-string-invalid-error (error) + ((%version-string + :initarg :version-string + :reader %version-string) + (reason + :initarg :reason + :reader %reason)) + (:report + (lambda (condition stream) + (format stream "The version string ~S is valid.~@[~%~A~]" + (%version-string condition) (%reason condition))))) + + (defgeneric version-pre-release-p (version) + (:documentation "Returns non-NIL if VERSION is a pre-release.")) + (defgeneric version-pre-release-for (version) + (:documentation "If VERSION is a pre-release, returns an version specifier +stating for which version it is a pre-release.")) + (defgeneric version< (version-1 version-2) + (:documentation "Returns non-NIL if VERSION-1 is ordered before VERSION-2.")) + (defgeneric version-string (version) + (:documentation "Return a string that represents VERSION."))) + +;; Semantic version class +(with-upgradability () + (defparameter *semver-valid-chars* + '(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m + #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z + #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M + #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z + #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 + #\-) + "List of all characters valid in pre-release and build metadata segments.") + + (defclass semantic-version (version) + (core-segment + pre-release-segment + build-metadata-segment) + (:documentation + "Implements semantic version parsing and ordering as specified by + https://semver.org/spec/v2.0.0.html")) + + (defun split-semver-string (version-string) + "Given a semver string, split it into its three basic components: the core +segment, the pre-release segment, and the build segment. Returns the three +components in a list. If the component is missing from the string, it returns +NIL." + (let ((pre-release-separator-position (position #\- version-string)) + (build-separator-position (position #\+ version-string))) + ;; If the pre-release and build separators both exist and the former comes + ;; after the latter, treat the former as not existing. + (when (and pre-release-separator-position + build-separator-position + (> pre-release-separator-position build-separator-position)) + (setf pre-release-separator-position nil)) + (list + ;; The core segment + (subseq version-string 0 (or pre-release-separator-position + build-separator-position)) + ;; The pre-release segment + (when pre-release-separator-position + (subseq version-string (1+ pre-release-separator-position) + build-separator-position)) + ;; The build segment + (when build-separator-position + (subseq version-string (1+ build-separator-position)))))) + + (defun parse-semver-dot-separated-segment (segment-string identifier-valid-test transform on-error) + "Given a string consisting of any number of identifiers separated by +#\\. characters, return a list of the identifiers. + +Each identifier is checked with IDENTIFIER-VALID-TEST to ensure it is valid. + +Then if the identifier is valid, TRANSFORM is called to canonicalize the +identifier. + +If there are any invalid segments, ON-ERROR is called with a string describing +the problem." + (let ((raw-identifiers (split-string segment-string :separator '(#\.)))) + (dolist (raw-identifier raw-identifiers) + (when (emptyp raw-identifier) + (call-function on-error (format nil "Invalid identifier ~S" raw-identifier))) + (unless (call-function identifier-valid-test raw-identifier) + (call-function on-error (format nil "Invalid identifier ~S" raw-identifier)))) + (mapcar transform raw-identifiers))) + + (defun valid-core-segment-identifier-p (string &key (on-leading-zero :warn)) + "An identifier is valid for use in the core segment if it is a non-negative +integer. + +ON-LEADING-ZERO specifies how to handle leading zeros in identifier. If :WARN, +a warning is signaled and the identifier is considered valid. If :IGNORE, the +identifier is considered valid. If INVALID, the identifier is not considered +valid." + (check-type on-leading-zero (member :warn :invalid :ignore)) + (and (every #'digit-char-p string) + (or (= 1 (length string)) + (not (eql (aref string 0) #\0)) + (ecase on-leading-zero + (:warn + (warn "Identifier ~S contains a leading zero." string) + t) + (:ignore + t) + (:invalid + nil))))) + + (defun valid-pre-release-segment-identifier-p (string &key (on-leading-zero :warn)) + "An identifier is valid for use in the pre-release segment if it is a +non-negative integer or consists entirely of alphanumeric and #\\- characters. + +See VALID-CORE-SEGMENT-IDENTIFIER-P for a discussion of ON-LEADING-ZERO." + (check-type on-leading-zero (member :warn :invalid :ignore)) + (and (every (lambda (c) (member c *semver-valid-chars*)) string) + (or (notevery #'digit-char-p string) + (valid-core-segment-identifier-p string :on-leading-zero on-leading-zero)))) + + (defun valid-build-segment-identifier-p (string) + "An identifier is valid for use in the build segment if it consists +entirely of alphanumeris and #\\- characters." + (every (lambda (c) (member c *semver-valid-chars*)) string)) + + (defun transform-pre-release-segment-identifier (string) + "If STRING consistes only of numeric characters, parse it as an integer and +return it. Otherwise, return STRING." + (let ((as-integer (ignore-errors (parse-integer string)))) + (if (and as-integer (not (minusp as-integer))) + as-integer + string))) + + (defun parse-semver-string (version-string) + "Given a string nominally representing a version string in the semantic +version grammar, return three VALUES: the list of core segment identifiers, the +list of pre-release segment identifiers, and the list of build metadata +identifiers. + +If VERSION-STRING contains leading zeros in a numeric identifier, a warning is +signaled. + +If VERSION-STRING is otherwise invalid, a VERSION-STRING-INVALID-ERROR is signaled." + (destructuring-bind (core-segment-string pre-release-segment-string build-segment-string) + (split-semver-string version-string) + (flet ((invalid (&optional reason) + (error 'version-string-invalid-error :version-string version-string + :reason reason))) + (when (null core-segment-string) + (invalid "There is no core segment.")) + (when (and (stringp pre-release-segment-string) + (emptyp pre-release-segment-string)) + (invalid "There is a #\\- character, but the pre-release segment is empty.")) + (when (and (stringp build-segment-string) + (emptyp build-segment-string)) + (invalid "There is a #\\+ character, but the build segment is empty.")) + + (let ((core-segment + (parse-semver-dot-separated-segment core-segment-string 'valid-core-segment-identifier-p #'parse-integer #'invalid)) + (pre-release-segment + (parse-semver-dot-separated-segment pre-release-segment-string 'valid-pre-release-segment-identifier-p 'transform-pre-release-segment-identifier #'invalid)) + (build-metadata + (parse-semver-dot-separated-segment build-segment-string 'valid-build-segment-identifier-p #'identity #'invalid))) + (values core-segment pre-release-segment build-metadata))))) + + (defmethod initialize-instance :after ((version semantic-version) &key version-string) + (with-slots (core-segment pre-release-segment build-metadata-segment) version + (multiple-value-setq + (core-segment pre-release-segment build-metadata-segment) + (parse-semver-string version-string)))) + + (defun semver-pre-release-segment-< (identifier1 identifier2) + (cond + ((and (integerp identifier1) (integerp identifier2)) + (< identifier1 identifier2)) + ((integerp identifier1) + t) + ((integerp identifier2) + nil) + (t + (string< identifier1 identifier2)))) + (defun semver-pre-release-< (pre-release-segment-1 pre-release-segment-2) + (or (and pre-release-segment-1 (null pre-release-segment-2)) + (lexicographic< 'semver-pre-release-segment-< pre-release-segment-1 pre-release-segment-2))) + + (defmethod version-pre-release-p ((version semantic-version)) + (with-slots (pre-release-segment) version + (not (null pre-release-segment)))) + (defmethod version-pre-release-for ((version semantic-version)) + (with-slots (core-segment) version + (make-instance (class-of version) :version-string (format nil "~{~D~^.~}" core-segment)))) + (defmethod version< ((version1 semantic-version) (version2 semantic-version)) + (with-slots ((core-segment-1 core-segment) (pre-release-segment-1 pre-release-segment)) version1 + (with-slots ((core-segment-2 core-segment) (pre-release-segment-2 pre-release-segment)) version2 + (or (lexicographic< #'< core-segment-1 core-segment-2) + (and (equal core-segment-1 core-segment-2) + (semver-pre-release-< pre-release-segment-1 pre-release-segment-2)))))) + (defmethod version-string ((version semantic-version)) + (with-slots (core-segment pre-release-segment build-metadata-segment) version + (format nil "~{~D~^.~}~@[-~{~A~^.~}~]~@[+~{~A~^.~}~]" + core-segment pre-release-segment build-metadata-segment)))) + +;; ASDF's opinionated default version. +(with-upgradability () + (defclass default-version (semantic-version) + () + (:documentation + "A version specifier that parses and orders identically to +SEMANTIC-VERSION. However, no build metadata is allowed and the pre-release +segment can consists of at most two identifiers. The first must be alpha, beta, +or rc. The second must be an integer.")) + + (defmethod initialize-instance :after ((version default-version) &key version-string) + (with-slots (pre-release-segment build-metadata-segment) version + (flet ((invalid (&optional reason) + (error 'version-string-invalid-error :version-string version-string + :reason reason))) + (unless (null build-metadata-segment) + (invalid "The build metadata segment must not exist.")) + (unless (or (null pre-release-segment) + (and (= 1 (length pre-release-segment)) + (or (equal "alpha" (first pre-release-segment)) + (equal "beta" (first pre-release-segment)) + (equal "rc" (first pre-release-segment)))) + (and (= 2 (length pre-release-segment)) + (or (equal "alpha" (first pre-release-segment)) + (equal "beta" (first pre-release-segment)) + (equal "rc" (first pre-release-segment))) + (integerp (second pre-release-segment)))) + (invalid "The pre-release segment must be absent or consist of \"alpha\", \"beta\", or \"rc\", optionally followed by an integer.")))))) diff --git a/uiop/version.lisp b/uiop/version.lisp index e8a9d546..e9bb6008 100644 --- a/uiop/version.lisp +++ b/uiop/version.lisp @@ -1,10 +1,9 @@ (uiop/package:define-package :uiop/version - (:recycle :uiop/version :uiop/utility :asdf) - (:use :uiop/common-lisp :uiop/package :uiop/utility) + (:recycle :uiop/version :uiop/version-specifier :uiop/utility :asdf) + (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/version-specifier) (:export #:*uiop-version* #:parse-version #:unparse-version #:version< #:version<= #:version= ;; version support, moved from uiop/utility - #:version-core-string #:next-version #:deprecated-function-condition #:deprecated-function-name ;; deprecation control #:deprecated-function-style-warning #:deprecated-function-warning @@ -15,116 +14,36 @@ (with-upgradability () (defparameter *uiop-version* "3.3.5.7") - (defparameter *pre-release-and-build-metadata-chars* - '(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m - #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z - #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M - #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z - #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 - #\-)) - - (defun unparse-version (version-list &optional pre-release-list build-metadata) - "From a parsed version (a list of natural numbers), compute the version -string. VERSION-LIST is a list of natural numbers. PRE-RELEASE-LIST is a list -of pre-release identifiers (strings or natural numbers). BUILD-METADATA is a -list of build metadata identifiers (strings or )string or NIL." - (format nil "~{~D~^.~}~@[-~{~A~^.~}~]~@[+~{~A~^.~}~]" version-list pre-release-list build-metadata)) - - (defun split-version-string (version-string) - "Given a semver string, split it into its three basic components: the core -segment, the pre-release segment, and the build segment. Returns the three -components in a list. If the component is missing from the string, it returns -nil." - (let ((pre-release-separator-position (position #\- version-string)) - (build-separator-position (position #\+ version-string))) - ;; If the pre-release and build separators both exist and the former comes - ;; after the latter, treat the former as not existing. - (when (and pre-release-separator-position - build-separator-position - (> pre-release-separator-position build-separator-position)) - (setf pre-release-separator-position nil)) - (list - ;; The core segment - (subseq version-string 0 (or pre-release-separator-position - build-separator-position)) - ;; The pre-release segment - (when pre-release-separator-position - (subseq version-string (1+ pre-release-separator-position) - build-separator-position)) - ;; The build segment - (when build-separator-position - (subseq version-string (1+ build-separator-position)))))) + (defun unparse-version (version-list) + "From a parsed version (a list of natural numbers), compute the version string" + (format nil "~{~D~^.~}" version-list)) (defun parse-version (version-string &optional on-error) - "Parse a VERSION-STRING as a core version followed by an optional -pre-release segment (preceded by a -), followed by an optional build metadata -segment (preceded by a +). Each segment is returned as a separate VALUE. - -The core version segment must consist entirely of natural numbers separated by -dots. The pre-release segment consists of a series of identifiers (consisting -of the characters 0-9, a-z, A-Z, and -), separated by dots. The build metadata -segment consists of a series of identifiers (consisting of the characters 0-9, -a-z, A-Z, and -), separated by dots. - -This grammar is heavily inspired by semver v2.0's grammar with the major -difference that the core version segment is not limited to exactly three dot -separated natural numbers. - -When invalid, ON-ERROR is called as per CALL-FUNCTION before returning NIL, -with format arguments explaining why the version is invalid. ON-ERROR is also -called if the version is not canonical in that it doesn't print back to itself, -but the values are returned anyway." + "Parse a VERSION-STRING as a series of natural numbers separated by dots. +Return a (non-null) list of integers if the string is valid; +otherwise return NIL. + +When invalid, ON-ERROR is called as per CALL-FUNCTION before to return NIL, +with format arguments explaining why the version is invalid. +ON-ERROR is also called if the version is not canonical +in that it doesn't print back to itself, but the list is returned anyway." (block nil (unless (stringp version-string) (call-function on-error "~S: ~S is not a string" 'parse-version version-string) (return)) - (destructuring-bind (core-segment-string pre-release-segment-string build-segment-string) - (split-version-string version-string) - (labels ((invalid () - (call-function on-error "~S: ~S doesn't follow asdf version numbering convention" - 'parse-version version-string)) - (parse-dot-separated-segment (segment-string character-test transform) - (unless (loop :for prev = nil :then c :for c :across segment-string - :always (or (funcall character-test c) - (and (eql c #\.) prev (not (eql prev #\.)))) - :finally (return (and c (funcall character-test c)))) - (invalid) - (return)) - (mapcar transform (split-string segment-string :separator "."))) - (parse-core-segment (segment-string) - (parse-dot-separated-segment segment-string #'digit-char-p #'parse-integer)) - (parse-pre-release-segment (segment-string) - (parse-dot-separated-segment segment-string - (lambda (c) - (member c *pre-release-and-build-metadata-chars*)) - (lambda (x) - (let ((as-integer (ignore-errors (parse-integer x)))) - (if (and as-integer (not (minusp as-integer))) - as-integer - x))))) - (parse-build-segment (segment-string) - (parse-dot-separated-segment segment-string - (lambda (c) - (member c *pre-release-and-build-metadata-chars*)) - #'identity))) - (unless core-segment-string - (invalid) - (return)) - (let* ((core-segment (parse-core-segment core-segment-string)) - (pre-release-segment (when pre-release-segment-string - (parse-pre-release-segment pre-release-segment-string))) - (build-segment (when build-segment-string - (parse-build-segment build-segment-string))) - (normalized-version (unparse-version core-segment pre-release-segment build-segment))) - (unless (equal version-string normalized-version) - (call-function on-error "~S: ~S contains leading zeros" 'parse-version version-string)) - (values core-segment pre-release-segment build-segment)))))) - - (defun version-core-string (version) - "When VERSION is not NIL, it is a string, then parse it as a version, -return the string corresponding to the core segment of VERSION." - (when version - (unparse-version (parse-version version)))) + (unless (loop :for prev = nil :then c :for c :across version-string + :always (or (digit-char-p c) + (and (eql c #\.) prev (not (eql prev #\.)))) + :finally (return (and c (digit-char-p c)))) + (call-function on-error "~S: ~S doesn't follow asdf version numbering convention" + 'parse-version version-string) + (return)) + (let* ((version-list + (mapcar #'parse-integer (split-string version-string :separator "."))) + (normalized-version (unparse-version version-list))) + (unless (equal version-string normalized-version) + (call-function on-error "~S: ~S contains leading zeros" 'parse-version version-string)) + version-list))) (defun next-version (version) "When VERSION is not nil, it is a string, then parse it as a version, compute the next version @@ -134,29 +53,10 @@ and return it as a string." (incf (car (last version-list))) (unparse-version version-list)))) - (defun version< (version1 version2) - "Given two version strings, return T if the second is strictly newer" - (multiple-value-bind (core-1 pre-release-1) - (parse-version version1) - (multiple-value-bind (core-2 pre-release-2) - (parse-version version2) - (labels ((identifier< (id1 id2) - (cond - ((and (integerp id1) (integerp id2)) - (< id1 id2)) - ((integerp id1) - t) - ((integerp id2) - nil) - (t - (string< id1 id2)))) - (pre-release-< (pr1 pr2) - (or - (and pr1 (null pr2)) - (lexicographic< #'identifier< pr1 pr2)))) - (or (lexicographic< '< core-1 core-2) - (and (equal core-1 core-2) - (pre-release-< pre-release-1 pre-release-2))))))) + (defmethod version< ((version1 string) version2) + (version< (make-instance 'default-version :version-string version1) version2)) + (defmethod version< (version1 (version2 string)) + (version< version1 (make-instance 'default-version :version-string version2))) (defun version<= (version1 version2) "Given two version strings, return T if the second is newer or the same" -- GitLab From 9341d69a0124ddd3fe0fcc17abb9b45231374f71 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 14:01:32 -0500 Subject: [PATCH 19/49] Remove version-specifier.lisp Move its contents into version.lisp --- Makefile | 2 +- make-asdf.bat | 2 +- make-asdf.sh | 2 +- uiop/uiop.asd | 3 +- uiop/version-specifier.lisp | 248 ---------------------------------- uiop/version.lisp | 256 +++++++++++++++++++++++++++++++++++- 6 files changed, 255 insertions(+), 258 deletions(-) delete mode 100644 uiop/version-specifier.lisp diff --git a/Makefile b/Makefile index cd92991a..7d621589 100644 --- a/Makefile +++ b/Makefile @@ -94,7 +94,7 @@ DOCKER_IMAGE_ECL_BYTECODES ?= containers.common-lisp.net/cl-docker-images/ecl DOCKER_IMAGE_SBCL ?= containers.common-lisp.net/cl-docker-images/sbcl header_lisp := header.lisp -driver_lisp := uiop/package.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/version-specifier.lisp uiop/version.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/lisp-build.lisp uiop/launch-program.lisp uiop/run-program.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/driver.lisp +driver_lisp := uiop/package.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/version.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/lisp-build.lisp uiop/launch-program.lisp uiop/run-program.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/driver.lisp defsystem_lisp := upgrade.lisp session.lisp component.lisp operation.lisp system.lisp system-registry.lisp action.lisp lisp-action.lisp find-component.lisp forcing.lisp plan.lisp operate.lisp find-system.lisp parse-defsystem.lisp bundle.lisp concatenate-source.lisp package-inferred-system.lisp output-translations.lisp source-registry.lisp backward-internals.lisp backward-interface.lisp interface.lisp user.lisp footer.lisp all_lisp := $(header_lisp) $(driver_lisp) $(defsystem_lisp) diff --git a/make-asdf.bat b/make-asdf.bat index 64233607..523fbe71 100644 --- a/make-asdf.bat +++ b/make-asdf.bat @@ -4,7 +4,7 @@ set here=%~dp0 set header_lisp=header.lisp -set driver_lisp=uiop\package.lisp + uiop\common-lisp.lisp + uiop\utility.lisp + uiop\version-specifier.lisp + uiop\version.lisp + uiop\os.lisp + uiop\pathname.lisp + uiop\filesystem.lisp + uiop\stream.lisp + uiop\image.lisp + uiop\lisp-build.lisp + uiop\launch-program.lisp + uiop\run-program.lisp + uiop\configuration.lisp + uiop\backward-driver.lisp + uiop\driver.lisp +set driver_lisp=uiop\package.lisp + uiop\common-lisp.lisp + uiop\utility.lisp + uiop\version.lisp + uiop\os.lisp + uiop\pathname.lisp + uiop\filesystem.lisp + uiop\stream.lisp + uiop\image.lisp + uiop\lisp-build.lisp + uiop\launch-program.lisp + uiop\run-program.lisp + uiop\configuration.lisp + uiop\backward-driver.lisp + uiop\driver.lisp set defsystem_lisp=upgrade.lisp + session.lisp + component.lisp + operation.lisp + system.lisp + system-registry.lisp + action.lisp + lisp-action.lisp + find-component.lisp + forcing.lisp + plan.lisp + operate.lisp + find-system.lisp + parse-defsystem.lisp + bundle.lisp + concatenate-source.lisp + package-inferred-system.lisp + output-translations.lisp + source-registry.lisp + backward-internals.lisp + backward-interface.lisp + interface.lisp + user.lisp + footer.lisp %~d0 diff --git a/make-asdf.sh b/make-asdf.sh index 38721545..ec429fd2 100755 --- a/make-asdf.sh +++ b/make-asdf.sh @@ -5,7 +5,7 @@ here="$(dirname $0)" header_lisp="header.lisp" -driver_lisp="uiop/package.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/version-specifier.lisp uiop/version.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/lisp-build.lisp uiop/launch-program.lisp uiop/run-program.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/driver.lisp" +driver_lisp="uiop/package.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/version.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/lisp-build.lisp uiop/launch-program.lisp uiop/run-program.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/driver.lisp" defsystem_lisp="upgrade.lisp session.lisp component.lisp operation.lisp system.lisp system-registry.lisp action.lisp lisp-action.lisp find-component.lisp forcing.lisp plan.lisp operate.lisp find-system.lisp parse-defsystem.lisp bundle.lisp concatenate-source.lisp package-inferred-system.lisp output-translations.lisp source-registry.lisp backward-internals.lisp backward-interface.lisp interface.lisp user.lisp footer.lisp" all () { diff --git a/uiop/uiop.asd b/uiop/uiop.asd index 4e4d2720..72fffb0d 100644 --- a/uiop/uiop.asd +++ b/uiop/uiop.asd @@ -32,8 +32,7 @@ you already have a matching UIOP loaded." (:file "package") (:file "common-lisp" :depends-on ("package")) (:file "utility" :depends-on ("common-lisp")) - (:file "version-specifier" :depends-on ("utility")) - (:file "version" :depends-on ("version-specifier")) + (:file "version" :depends-on ("utility")) (:file "os" :depends-on ("utility")) (:file "pathname" :depends-on ("utility" "os")) (:file "filesystem" :depends-on ("os" "pathname")) diff --git a/uiop/version-specifier.lisp b/uiop/version-specifier.lisp deleted file mode 100644 index 9715943a..00000000 --- a/uiop/version-specifier.lisp +++ /dev/null @@ -1,248 +0,0 @@ -(uiop/package:define-package :uiop/version-specifier - (:recycle :uiop/version-specifier :uiop/utility :asdf) - (:use :uiop/common-lisp :uiop/package :uiop/utility) - (:export - ;; Basic version API - #:version #:version-string-invalid-error #:version-pre-release-p #:version-pre-release-for - #:version< #:version-string - - ;; Semantic versions - #:semantic-version - - ;; Default versions - #:default-version)) -(in-package :uiop/version-specifier) - -;; Base version class -(with-upgradability () - (defclass version () - () - (:documentation - "The base class of version specifiers.")) - - (define-condition version-string-invalid-error (error) - ((%version-string - :initarg :version-string - :reader %version-string) - (reason - :initarg :reason - :reader %reason)) - (:report - (lambda (condition stream) - (format stream "The version string ~S is valid.~@[~%~A~]" - (%version-string condition) (%reason condition))))) - - (defgeneric version-pre-release-p (version) - (:documentation "Returns non-NIL if VERSION is a pre-release.")) - (defgeneric version-pre-release-for (version) - (:documentation "If VERSION is a pre-release, returns an version specifier -stating for which version it is a pre-release.")) - (defgeneric version< (version-1 version-2) - (:documentation "Returns non-NIL if VERSION-1 is ordered before VERSION-2.")) - (defgeneric version-string (version) - (:documentation "Return a string that represents VERSION."))) - -;; Semantic version class -(with-upgradability () - (defparameter *semver-valid-chars* - '(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m - #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z - #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M - #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z - #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 - #\-) - "List of all characters valid in pre-release and build metadata segments.") - - (defclass semantic-version (version) - (core-segment - pre-release-segment - build-metadata-segment) - (:documentation - "Implements semantic version parsing and ordering as specified by - https://semver.org/spec/v2.0.0.html")) - - (defun split-semver-string (version-string) - "Given a semver string, split it into its three basic components: the core -segment, the pre-release segment, and the build segment. Returns the three -components in a list. If the component is missing from the string, it returns -NIL." - (let ((pre-release-separator-position (position #\- version-string)) - (build-separator-position (position #\+ version-string))) - ;; If the pre-release and build separators both exist and the former comes - ;; after the latter, treat the former as not existing. - (when (and pre-release-separator-position - build-separator-position - (> pre-release-separator-position build-separator-position)) - (setf pre-release-separator-position nil)) - (list - ;; The core segment - (subseq version-string 0 (or pre-release-separator-position - build-separator-position)) - ;; The pre-release segment - (when pre-release-separator-position - (subseq version-string (1+ pre-release-separator-position) - build-separator-position)) - ;; The build segment - (when build-separator-position - (subseq version-string (1+ build-separator-position)))))) - - (defun parse-semver-dot-separated-segment (segment-string identifier-valid-test transform on-error) - "Given a string consisting of any number of identifiers separated by -#\\. characters, return a list of the identifiers. - -Each identifier is checked with IDENTIFIER-VALID-TEST to ensure it is valid. - -Then if the identifier is valid, TRANSFORM is called to canonicalize the -identifier. - -If there are any invalid segments, ON-ERROR is called with a string describing -the problem." - (let ((raw-identifiers (split-string segment-string :separator '(#\.)))) - (dolist (raw-identifier raw-identifiers) - (when (emptyp raw-identifier) - (call-function on-error (format nil "Invalid identifier ~S" raw-identifier))) - (unless (call-function identifier-valid-test raw-identifier) - (call-function on-error (format nil "Invalid identifier ~S" raw-identifier)))) - (mapcar transform raw-identifiers))) - - (defun valid-core-segment-identifier-p (string &key (on-leading-zero :warn)) - "An identifier is valid for use in the core segment if it is a non-negative -integer. - -ON-LEADING-ZERO specifies how to handle leading zeros in identifier. If :WARN, -a warning is signaled and the identifier is considered valid. If :IGNORE, the -identifier is considered valid. If INVALID, the identifier is not considered -valid." - (check-type on-leading-zero (member :warn :invalid :ignore)) - (and (every #'digit-char-p string) - (or (= 1 (length string)) - (not (eql (aref string 0) #\0)) - (ecase on-leading-zero - (:warn - (warn "Identifier ~S contains a leading zero." string) - t) - (:ignore - t) - (:invalid - nil))))) - - (defun valid-pre-release-segment-identifier-p (string &key (on-leading-zero :warn)) - "An identifier is valid for use in the pre-release segment if it is a -non-negative integer or consists entirely of alphanumeric and #\\- characters. - -See VALID-CORE-SEGMENT-IDENTIFIER-P for a discussion of ON-LEADING-ZERO." - (check-type on-leading-zero (member :warn :invalid :ignore)) - (and (every (lambda (c) (member c *semver-valid-chars*)) string) - (or (notevery #'digit-char-p string) - (valid-core-segment-identifier-p string :on-leading-zero on-leading-zero)))) - - (defun valid-build-segment-identifier-p (string) - "An identifier is valid for use in the build segment if it consists -entirely of alphanumeris and #\\- characters." - (every (lambda (c) (member c *semver-valid-chars*)) string)) - - (defun transform-pre-release-segment-identifier (string) - "If STRING consistes only of numeric characters, parse it as an integer and -return it. Otherwise, return STRING." - (let ((as-integer (ignore-errors (parse-integer string)))) - (if (and as-integer (not (minusp as-integer))) - as-integer - string))) - - (defun parse-semver-string (version-string) - "Given a string nominally representing a version string in the semantic -version grammar, return three VALUES: the list of core segment identifiers, the -list of pre-release segment identifiers, and the list of build metadata -identifiers. - -If VERSION-STRING contains leading zeros in a numeric identifier, a warning is -signaled. - -If VERSION-STRING is otherwise invalid, a VERSION-STRING-INVALID-ERROR is signaled." - (destructuring-bind (core-segment-string pre-release-segment-string build-segment-string) - (split-semver-string version-string) - (flet ((invalid (&optional reason) - (error 'version-string-invalid-error :version-string version-string - :reason reason))) - (when (null core-segment-string) - (invalid "There is no core segment.")) - (when (and (stringp pre-release-segment-string) - (emptyp pre-release-segment-string)) - (invalid "There is a #\\- character, but the pre-release segment is empty.")) - (when (and (stringp build-segment-string) - (emptyp build-segment-string)) - (invalid "There is a #\\+ character, but the build segment is empty.")) - - (let ((core-segment - (parse-semver-dot-separated-segment core-segment-string 'valid-core-segment-identifier-p #'parse-integer #'invalid)) - (pre-release-segment - (parse-semver-dot-separated-segment pre-release-segment-string 'valid-pre-release-segment-identifier-p 'transform-pre-release-segment-identifier #'invalid)) - (build-metadata - (parse-semver-dot-separated-segment build-segment-string 'valid-build-segment-identifier-p #'identity #'invalid))) - (values core-segment pre-release-segment build-metadata))))) - - (defmethod initialize-instance :after ((version semantic-version) &key version-string) - (with-slots (core-segment pre-release-segment build-metadata-segment) version - (multiple-value-setq - (core-segment pre-release-segment build-metadata-segment) - (parse-semver-string version-string)))) - - (defun semver-pre-release-segment-< (identifier1 identifier2) - (cond - ((and (integerp identifier1) (integerp identifier2)) - (< identifier1 identifier2)) - ((integerp identifier1) - t) - ((integerp identifier2) - nil) - (t - (string< identifier1 identifier2)))) - (defun semver-pre-release-< (pre-release-segment-1 pre-release-segment-2) - (or (and pre-release-segment-1 (null pre-release-segment-2)) - (lexicographic< 'semver-pre-release-segment-< pre-release-segment-1 pre-release-segment-2))) - - (defmethod version-pre-release-p ((version semantic-version)) - (with-slots (pre-release-segment) version - (not (null pre-release-segment)))) - (defmethod version-pre-release-for ((version semantic-version)) - (with-slots (core-segment) version - (make-instance (class-of version) :version-string (format nil "~{~D~^.~}" core-segment)))) - (defmethod version< ((version1 semantic-version) (version2 semantic-version)) - (with-slots ((core-segment-1 core-segment) (pre-release-segment-1 pre-release-segment)) version1 - (with-slots ((core-segment-2 core-segment) (pre-release-segment-2 pre-release-segment)) version2 - (or (lexicographic< #'< core-segment-1 core-segment-2) - (and (equal core-segment-1 core-segment-2) - (semver-pre-release-< pre-release-segment-1 pre-release-segment-2)))))) - (defmethod version-string ((version semantic-version)) - (with-slots (core-segment pre-release-segment build-metadata-segment) version - (format nil "~{~D~^.~}~@[-~{~A~^.~}~]~@[+~{~A~^.~}~]" - core-segment pre-release-segment build-metadata-segment)))) - -;; ASDF's opinionated default version. -(with-upgradability () - (defclass default-version (semantic-version) - () - (:documentation - "A version specifier that parses and orders identically to -SEMANTIC-VERSION. However, no build metadata is allowed and the pre-release -segment can consists of at most two identifiers. The first must be alpha, beta, -or rc. The second must be an integer.")) - - (defmethod initialize-instance :after ((version default-version) &key version-string) - (with-slots (pre-release-segment build-metadata-segment) version - (flet ((invalid (&optional reason) - (error 'version-string-invalid-error :version-string version-string - :reason reason))) - (unless (null build-metadata-segment) - (invalid "The build metadata segment must not exist.")) - (unless (or (null pre-release-segment) - (and (= 1 (length pre-release-segment)) - (or (equal "alpha" (first pre-release-segment)) - (equal "beta" (first pre-release-segment)) - (equal "rc" (first pre-release-segment)))) - (and (= 2 (length pre-release-segment)) - (or (equal "alpha" (first pre-release-segment)) - (equal "beta" (first pre-release-segment)) - (equal "rc" (first pre-release-segment))) - (integerp (second pre-release-segment)))) - (invalid "The pre-release segment must be absent or consist of \"alpha\", \"beta\", or \"rc\", optionally followed by an integer.")))))) diff --git a/uiop/version.lisp b/uiop/version.lisp index e9bb6008..c91e11ce 100644 --- a/uiop/version.lisp +++ b/uiop/version.lisp @@ -1,8 +1,11 @@ (uiop/package:define-package :uiop/version - (:recycle :uiop/version :uiop/version-specifier :uiop/utility :asdf) - (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/version-specifier) + (:recycle :uiop/version :uiop/utility :asdf) + (:use :uiop/common-lisp :uiop/package :uiop/utility) (:export #:*uiop-version* + #:version #:version-string-invalid-error #:version-pre-release-p #:version-pre-release-for + #:version-string + #:semantic-version #:default-version #:parse-version #:unparse-version #:version< #:version<= #:version= ;; version support, moved from uiop/utility #:next-version #:deprecated-function-condition #:deprecated-function-name ;; deprecation control @@ -12,8 +15,251 @@ (in-package :uiop/version) (with-upgradability () - (defparameter *uiop-version* "3.3.5.7") + (defparameter *uiop-version* "3.3.5.7")) +;; Base version class and API. +(with-upgradability () + (defclass version () + () + (:documentation + "The base class of version specifiers.")) + + (define-condition version-string-invalid-error (error) + ((%version-string + :initarg :version-string + :reader %version-string) + (reason + :initarg :reason + :reader %reason)) + (:report + (lambda (condition stream) + (format stream "The version string ~S is valid.~@[~%~A~]" + (%version-string condition) (%reason condition))))) + + (defun make-version (version-string &key (class 'default-version)) + (make-instance class :version-string version-string)) + (defgeneric version-pre-release-p (version) + (:documentation "Returns non-NIL if VERSION is a pre-release.")) + (defgeneric version-pre-release-for (version) + (:documentation "If VERSION is a pre-release, returns an version specifier +stating for which version it is a pre-release.")) + (when (and (symbol-function 'version<) + (not (typep (symbol-function 'version<) 'generic-function))) + ;; ASDF 3.4: Turned from function to generic function. Only conditionally + ;; making it unbound because this is an extension point for the user and we + ;; don't want to gratuitously remove their methods. + (fmakunbound 'version<)) + (defgeneric version< (version-1 version-2) + (:documentation "Returns non-NIL if VERSION-1 is ordered before VERSION-2.")) + (defgeneric version-string (version) + (:documentation "Return a string that represents VERSION."))) + +;; Semantic version class +(with-upgradability () + (defparameter *semver-valid-chars* + '(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m + #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z + #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M + #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z + #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 + #\-) + "List of all characters valid in pre-release and build metadata segments.") + + (defclass semantic-version (version) + (core-segment + pre-release-segment + build-metadata-segment) + (:documentation + "Implements semantic version parsing and ordering as specified by + https://semver.org/spec/v2.0.0.html")) + + (defun split-semver-string (version-string) + "Given a semver string, split it into its three basic components: the core +segment, the pre-release segment, and the build segment. Returns the three +components in a list. If the component is missing from the string, it returns +NIL." + (let ((pre-release-separator-position (position #\- version-string)) + (build-separator-position (position #\+ version-string))) + ;; If the pre-release and build separators both exist and the former comes + ;; after the latter, treat the former as not existing. + (when (and pre-release-separator-position + build-separator-position + (> pre-release-separator-position build-separator-position)) + (setf pre-release-separator-position nil)) + (list + ;; The core segment + (subseq version-string 0 (or pre-release-separator-position + build-separator-position)) + ;; The pre-release segment + (when pre-release-separator-position + (subseq version-string (1+ pre-release-separator-position) + build-separator-position)) + ;; The build segment + (when build-separator-position + (subseq version-string (1+ build-separator-position)))))) + + (defun parse-semver-dot-separated-segment (segment-string identifier-valid-test transform on-error) + "Given a string consisting of any number of identifiers separated by +#\\. characters, return a list of the identifiers. + +Each identifier is checked with IDENTIFIER-VALID-TEST to ensure it is valid. + +Then if the identifier is valid, TRANSFORM is called to canonicalize the +identifier. + +If there are any invalid segments, ON-ERROR is called with a string describing +the problem." + (let ((raw-identifiers (split-string segment-string :separator '(#\.)))) + (dolist (raw-identifier raw-identifiers) + (when (emptyp raw-identifier) + (call-function on-error (format nil "Invalid identifier ~S" raw-identifier))) + (unless (call-function identifier-valid-test raw-identifier) + (call-function on-error (format nil "Invalid identifier ~S" raw-identifier)))) + (mapcar transform raw-identifiers))) + + (defun valid-core-segment-identifier-p (string &key (on-leading-zero :warn)) + "An identifier is valid for use in the core segment if it is a non-negative +integer. + +ON-LEADING-ZERO specifies how to handle leading zeros in identifier. If :WARN, +a warning is signaled and the identifier is considered valid. If :IGNORE, the +identifier is considered valid. If INVALID, the identifier is not considered +valid." + (check-type on-leading-zero (member :warn :invalid :ignore)) + (and (every #'digit-char-p string) + (or (= 1 (length string)) + (not (eql (aref string 0) #\0)) + (ecase on-leading-zero + (:warn + (warn "Identifier ~S contains a leading zero." string) + t) + (:ignore + t) + (:invalid + nil))))) + + (defun valid-pre-release-segment-identifier-p (string &key (on-leading-zero :warn)) + "An identifier is valid for use in the pre-release segment if it is a +non-negative integer or consists entirely of alphanumeric and #\\- characters. + +See VALID-CORE-SEGMENT-IDENTIFIER-P for a discussion of ON-LEADING-ZERO." + (check-type on-leading-zero (member :warn :invalid :ignore)) + (and (every (lambda (c) (member c *semver-valid-chars*)) string) + (or (notevery #'digit-char-p string) + (valid-core-segment-identifier-p string :on-leading-zero on-leading-zero)))) + + (defun valid-build-segment-identifier-p (string) + "An identifier is valid for use in the build segment if it consists +entirely of alphanumeris and #\\- characters." + (every (lambda (c) (member c *semver-valid-chars*)) string)) + + (defun transform-pre-release-segment-identifier (string) + "If STRING consistes only of numeric characters, parse it as an integer and +return it. Otherwise, return STRING." + (let ((as-integer (ignore-errors (parse-integer string)))) + (if (and as-integer (not (minusp as-integer))) + as-integer + string))) + + (defun parse-semver-string (version-string) + "Given a string nominally representing a version string in the semantic +version grammar, return three VALUES: the list of core segment identifiers, the +list of pre-release segment identifiers, and the list of build metadata +identifiers. + +If VERSION-STRING contains leading zeros in a numeric identifier, a warning is +signaled. + +If VERSION-STRING is otherwise invalid, a VERSION-STRING-INVALID-ERROR is signaled." + (destructuring-bind (core-segment-string pre-release-segment-string build-segment-string) + (split-semver-string version-string) + (flet ((invalid (&optional reason) + (error 'version-string-invalid-error :version-string version-string + :reason reason))) + (when (null core-segment-string) + (invalid "There is no core segment.")) + (when (and (stringp pre-release-segment-string) + (emptyp pre-release-segment-string)) + (invalid "There is a #\\- character, but the pre-release segment is empty.")) + (when (and (stringp build-segment-string) + (emptyp build-segment-string)) + (invalid "There is a #\\+ character, but the build segment is empty.")) + + (let ((core-segment + (parse-semver-dot-separated-segment core-segment-string 'valid-core-segment-identifier-p #'parse-integer #'invalid)) + (pre-release-segment + (parse-semver-dot-separated-segment pre-release-segment-string 'valid-pre-release-segment-identifier-p 'transform-pre-release-segment-identifier #'invalid)) + (build-metadata + (parse-semver-dot-separated-segment build-segment-string 'valid-build-segment-identifier-p #'identity #'invalid))) + (values core-segment pre-release-segment build-metadata))))) + + (defmethod initialize-instance :after ((version semantic-version) &key version-string) + (with-slots (core-segment pre-release-segment build-metadata-segment) version + (multiple-value-setq + (core-segment pre-release-segment build-metadata-segment) + (parse-semver-string version-string)))) + + (defun semver-pre-release-segment-< (identifier1 identifier2) + (cond + ((and (integerp identifier1) (integerp identifier2)) + (< identifier1 identifier2)) + ((integerp identifier1) + t) + ((integerp identifier2) + nil) + (t + (string< identifier1 identifier2)))) + (defun semver-pre-release-< (pre-release-segment-1 pre-release-segment-2) + (or (and pre-release-segment-1 (null pre-release-segment-2)) + (lexicographic< 'semver-pre-release-segment-< pre-release-segment-1 pre-release-segment-2))) + + (defmethod version-pre-release-p ((version semantic-version)) + (with-slots (pre-release-segment) version + (not (null pre-release-segment)))) + (defmethod version-pre-release-for ((version semantic-version)) + (with-slots (core-segment) version + (make-version (format nil "~{~D~^.~}" core-segment) :class (class-of version)))) + (defmethod version< ((version1 semantic-version) (version2 semantic-version)) + (with-slots ((core-segment-1 core-segment) (pre-release-segment-1 pre-release-segment)) version1 + (with-slots ((core-segment-2 core-segment) (pre-release-segment-2 pre-release-segment)) version2 + (or (lexicographic< #'< core-segment-1 core-segment-2) + (and (equal core-segment-1 core-segment-2) + (semver-pre-release-< pre-release-segment-1 pre-release-segment-2)))))) + (defmethod version-string ((version semantic-version)) + (with-slots (core-segment pre-release-segment build-metadata-segment) version + (format nil "~{~D~^.~}~@[-~{~A~^.~}~]~@[+~{~A~^.~}~]" + core-segment pre-release-segment build-metadata-segment)))) + +;; ASDF's (slightly) opinionated default version. +(with-upgradability () + (defclass default-version (semantic-version) + () + (:documentation + "A version specifier that parses and orders identically to +SEMANTIC-VERSION. However, no build metadata is allowed and the pre-release +segment can consist of at most two identifiers. The first must be \"alpha\", +\"beta\", or \"rc\". The second must be an integer.")) + + (defmethod initialize-instance :after ((version default-version) &key version-string) + (with-slots (pre-release-segment build-metadata-segment) version + (flet ((invalid (&optional reason) + (error 'version-string-invalid-error :version-string version-string + :reason reason))) + (unless (null build-metadata-segment) + (invalid "The build metadata segment must not exist.")) + (unless (or (null pre-release-segment) + (and (= 1 (length pre-release-segment)) + (or (equal "alpha" (first pre-release-segment)) + (equal "beta" (first pre-release-segment)) + (equal "rc" (first pre-release-segment)))) + (and (= 2 (length pre-release-segment)) + (or (equal "alpha" (first pre-release-segment)) + (equal "beta" (first pre-release-segment)) + (equal "rc" (first pre-release-segment))) + (integerp (second pre-release-segment)))) + (invalid "The pre-release segment must be absent or consist of \"alpha\", \"beta\", or \"rc\", optionally followed by an integer.")))))) + +(with-upgradability () (defun unparse-version (version-list) "From a parsed version (a list of natural numbers), compute the version string" (format nil "~{~D~^.~}" version-list)) @@ -54,9 +300,9 @@ and return it as a string." (unparse-version version-list)))) (defmethod version< ((version1 string) version2) - (version< (make-instance 'default-version :version-string version1) version2)) + (version< (make-version version1) version2)) (defmethod version< (version1 (version2 string)) - (version< version1 (make-instance 'default-version :version-string version2))) + (version< version1 (make-version version2))) (defun version<= (version1 version2) "Given two version strings, return T if the second is newer or the same" -- GitLab From 0e0646d26990fc0e2b10563166dff9ef5a416e1c Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 14:36:12 -0500 Subject: [PATCH 20/49] Switch deprecation macros over to new functions Additionally, deprecate NEXT-VERSION PARSE-VERSION and UNPARSE-VERSION --- uiop/version.lisp | 140 +++++++++++++++++++++++++++------------------- 1 file changed, 81 insertions(+), 59 deletions(-) diff --git a/uiop/version.lisp b/uiop/version.lisp index c91e11ce..bf73e28c 100644 --- a/uiop/version.lisp +++ b/uiop/version.lisp @@ -4,7 +4,7 @@ (:export #:*uiop-version* #:version #:version-string-invalid-error #:version-pre-release-p #:version-pre-release-for - #:version-string + #:version-next #:version-string #:semantic-version #:default-version #:parse-version #:unparse-version #:version< #:version<= #:version= ;; version support, moved from uiop/utility #:next-version @@ -24,6 +24,10 @@ (:documentation "The base class of version specifiers.")) + (defmethod print-object ((version version) stream) + (print-unreadable-object (version stream :type t :identity t) + (format stream "~A" (version-string version)))) + (define-condition version-string-invalid-error (error) ((%version-string :initarg :version-string @@ -38,6 +42,11 @@ (defun make-version (version-string &key (class 'default-version)) (make-instance class :version-string version-string)) + (defgeneric version-next (version) + (:documentation "Returns the next version after VERSION. The returned +version must not be a pre-release.") + (:method ((version null)) + nil)) (defgeneric version-pre-release-p (version) (:documentation "Returns non-NIL if VERSION is a pre-release.")) (defgeneric version-pre-release-for (version) @@ -52,7 +61,16 @@ stating for which version it is a pre-release.")) (defgeneric version< (version-1 version-2) (:documentation "Returns non-NIL if VERSION-1 is ordered before VERSION-2.")) (defgeneric version-string (version) - (:documentation "Return a string that represents VERSION."))) + (:documentation "Return a string that represents VERSION.")) + + (defun version<= (version1 version2) + "Given two version strings, return T if the second is newer or the same" + (not (version< version2 version1))) + (defun version= (version1 version2) + "Given two version strings, return T if the first is newer or the same and +the second is also newer or the same." + (and (version<= version1 version2) + (version<= version2 version1)))) ;; Semantic version class (with-upgradability () @@ -213,6 +231,11 @@ If VERSION-STRING is otherwise invalid, a VERSION-STRING-INVALID-ERROR is signal (or (and pre-release-segment-1 (null pre-release-segment-2)) (lexicographic< 'semver-pre-release-segment-< pre-release-segment-1 pre-release-segment-2))) + (defmethod version-next ((version semantic-version)) + (with-slots (core-segment) version + (let ((new-core-segment (copy-list core-segment))) + (incf (car (last new-core-segment))) + (make-version (format nil "~{~D~^.~}" new-core-segment) :class (class-of version))))) (defmethod version-pre-release-p ((version semantic-version)) (with-slots (pre-release-segment) version (not (null pre-release-segment)))) @@ -257,63 +280,14 @@ segment can consist of at most two identifiers. The first must be \"alpha\", (equal "beta" (first pre-release-segment)) (equal "rc" (first pre-release-segment))) (integerp (second pre-release-segment)))) - (invalid "The pre-release segment must be absent or consist of \"alpha\", \"beta\", or \"rc\", optionally followed by an integer.")))))) - -(with-upgradability () - (defun unparse-version (version-list) - "From a parsed version (a list of natural numbers), compute the version string" - (format nil "~{~D~^.~}" version-list)) - - (defun parse-version (version-string &optional on-error) - "Parse a VERSION-STRING as a series of natural numbers separated by dots. -Return a (non-null) list of integers if the string is valid; -otherwise return NIL. - -When invalid, ON-ERROR is called as per CALL-FUNCTION before to return NIL, -with format arguments explaining why the version is invalid. -ON-ERROR is also called if the version is not canonical -in that it doesn't print back to itself, but the list is returned anyway." - (block nil - (unless (stringp version-string) - (call-function on-error "~S: ~S is not a string" 'parse-version version-string) - (return)) - (unless (loop :for prev = nil :then c :for c :across version-string - :always (or (digit-char-p c) - (and (eql c #\.) prev (not (eql prev #\.)))) - :finally (return (and c (digit-char-p c)))) - (call-function on-error "~S: ~S doesn't follow asdf version numbering convention" - 'parse-version version-string) - (return)) - (let* ((version-list - (mapcar #'parse-integer (split-string version-string :separator "."))) - (normalized-version (unparse-version version-list))) - (unless (equal version-string normalized-version) - (call-function on-error "~S: ~S contains leading zeros" 'parse-version version-string)) - version-list))) - - (defun next-version (version) - "When VERSION is not nil, it is a string, then parse it as a version, compute the next version -and return it as a string." - (when version - (let ((version-list (parse-version version))) - (incf (car (last version-list))) - (unparse-version version-list)))) + (invalid "The pre-release segment must be absent or consist of \"alpha\", \"beta\", or \"rc\", optionally followed by an integer."))))) + (defmethod version-next ((version string)) + (version-next (make-version version))) (defmethod version< ((version1 string) version2) (version< (make-version version1) version2)) (defmethod version< (version1 (version2 string)) - (version< version1 (make-version version2))) - - (defun version<= (version1 version2) - "Given two version strings, return T if the second is newer or the same" - (not (version< version2 version1)))) - - (defun version= (version1 version2) - "Given two version strings, return T if the first is newer or the same and -the second is also newer or the same." - (and (version<= version1 version2) - (version<= version2 version1))) - + (version< version1 (make-version version2)))) (with-upgradability () (define-condition deprecated-function-condition (condition) @@ -359,14 +333,14 @@ the second is also newer or the same." ((:error) (cerror "USE FUNCTION ANYWAY" 'deprecated-function-error :name name)))) (defun version-deprecation (version &key (style-warning nil) - (warning (next-version style-warning)) - (error (next-version warning)) - (delete (next-version error))) + (warning (version-next style-warning)) + (error (version-next warning)) + (delete (version-next error))) "Given a VERSION string, and the starting versions for notifying the programmer of various levels of deprecation, return the current level of deprecation as per WITH-DEPRECATION that is the highest level that has a declared version older than the specified version. Each start version for a level of deprecation can be specified by a keyword argument, or -if left unspecified, will be the NEXT-VERSION of the immediate lower level of deprecation." +if left unspecified, will be the VERSION-NEXT of the immediate lower level of deprecation." (cond ((and delete (version<= delete version)) :delete) ((and error (version<= error version)) :error) @@ -430,3 +404,51 @@ from instrumentation by enclosing it in a PROGN." form))) (t form)))))))) + +;; All of these were deprecated in 3.4 +(with-upgradability () + (with-deprecation ((version-deprecation *uiop-version* :style-warning "3.4" :delete "4.0")) + (defun unparse-version (version-list) + "DEPRECATED. Use VERSION-STRING instead. + +From a parsed version (a list of natural numbers), compute the version string" + (format nil "~{~D~^.~}" version-list)) + + (defun parse-version (version-string &optional on-error) + "DEPRECATED. Use MAKE-VERSION instead. + +Parse a VERSION-STRING as a series of natural numbers separated by dots. +Return a (non-null) list of integers if the string is valid; +otherwise return NIL. + +When invalid, ON-ERROR is called as per CALL-FUNCTION before to return NIL, +with format arguments explaining why the version is invalid. +ON-ERROR is also called if the version is not canonical +in that it doesn't print back to itself, but the list is returned anyway." + (block nil + (unless (stringp version-string) + (call-function on-error "~S: ~S is not a string" 'parse-version version-string) + (return)) + (unless (loop :for prev = nil :then c :for c :across version-string + :always (or (digit-char-p c) + (and (eql c #\.) prev (not (eql prev #\.)))) + :finally (return (and c (digit-char-p c)))) + (call-function on-error "~S: ~S doesn't follow asdf version numbering convention" + 'parse-version version-string) + (return)) + (let* ((version-list + (mapcar #'parse-integer (split-string version-string :separator "."))) + (normalized-version (unparse-version version-list))) + (unless (equal version-string normalized-version) + (call-function on-error "~S: ~S contains leading zeros" 'parse-version version-string)) + version-list))) + + (defun next-version (version) + "DEPRECATED. Use VERSION-NEXT instead. + +When VERSION is not nil, it is a string, then parse it as a version, compute the next version +and return it as a string." + (when version + (let ((version-list (parse-version version))) + (incf (car (last version-list))) + (unparse-version version-list)))))) -- GitLab From b28d188f93f0b333ef45053355735da3c3af1e96 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 16:31:25 -0500 Subject: [PATCH 21/49] Update COMPONENT-VERSION --- component.lisp | 76 +++++++++++++++++++++++------------------------ uiop/version.lisp | 48 ++++++++++++++++++------------ 2 files changed, 66 insertions(+), 58 deletions(-) diff --git a/component.lisp b/component.lisp index 76dca225..31c3ecd3 100644 --- a/component.lisp +++ b/component.lisp @@ -39,7 +39,13 @@ #:defsystem-depends-on ; This symbol retained for backward compatibility. #:sideway-dependencies #:if-feature #:in-order-to #:inline-methods #:relative-pathname #:absolute-pathname #:operation-times #:around-compile - #:%encoding #:properties #:component-properties #:parent)) + #:%encoding #:properties #:component-properties #:parent) + (:shadow + ;; UIOP started exporting VERSION in ASDF 3.4. VERSION is also the name of a + ;; slot in COMPONENT. Shadow VERSION so that we don't lose the value of that + ;; slot on upgrades. Otherwise, we'd need to + ;; UPDATE-INSTANCE-FOR-REDEFINED-CLASS. + #:version)) (in-package :asdf/component) (with-upgradability () @@ -65,13 +71,14 @@ Use asdf-encodings to support more encodings.")) (:documentation "Check whether a COMPONENT satisfies the constraint of being at least as recent as the specified VERSION, which must be a string of dot-separated natural numbers, or NIL.")) (defgeneric component-version (component) - (:documentation "Return the version of a COMPONENT in two VALUES. The -first value is a string of dot-separated natural numbers that specifies the -primary version number, or NIL. The second value is the full version string -that is suitable for display and may contain pre- or post-release information, -or NIL.")) ;; ASDF internals never use the second value. + (:documentation "Return the version of a COMPONENT in two VALUES. The first +value is a string that specifies the version, or NIL. The second value is +the UIOP:VERSION instance that is suitable for use with UIOP:VERSION<, or NIL.")) (defgeneric (setf component-version) (new-version component) (:documentation "Updates the version of a COMPONENT.")) + (defgeneric component-version-class (component) + (:documentation "Return the class COMPONENT uses to represent its +versions.")) (defgeneric component-parent (component) (:documentation "The parent of a child COMPONENT, or NIL for top-level components (a.k.a. systems)")) @@ -89,12 +96,12 @@ or NIL for top-level components (a.k.a. systems)")) (format s (compatfmt "~@") (duplicate-names-name c)))))) - (with-upgradability () (defclass component () ((name :accessor component-name :initarg :name :type string :documentation "Component name: designator for a string composed of portable pathname characters") (version :initarg :version :initform nil) + (version-class :reader component-version-class :initarg :version-class :initform 'uiop:default-version) (description :accessor component-description :initarg :description :initform nil) (long-description :accessor component-long-description :initarg :long-description :initform nil) (sideway-dependencies :accessor component-sideway-dependencies :initform nil) @@ -164,44 +171,35 @@ The return value is a list of component NAMES; a list of strings." component)) (defmethod component-version ((component component)) - "This method assumes that version has been normalized to a string of -dot-separated natural numbers." + "The VERSION slot of COMPONENT may be NIL, unbound, a string, or a +UIOP:VERSION object. If it's a string, update it to be a UIOP:VERSION object +and return it. If it's a UIOP:VERSION object, return it. Else, return NIL." (if-let (raw-version (and (slot-boundp component 'version) (slot-value component 'version))) (typecase raw-version (string ;; If we're upgrading ASDF and some systems have already been loaded, ;; they likely have the old representation of the version (plain - ;; string) stored. We could automatically rewrite the contents of the - ;; slot if this happens, but it should be rare since ASDF always tries - ;; to upgrade itself first. - (if-let (core-segment (parse-version raw-version)) - (values (unparse-version core-segment) raw-version))) - (cons - (values-list raw-version))))) - - (defmethod (setf component-version) (value (component component)) - (when (typep value 'string) - (if-let (core-segment (parse-version value)) - (let ((core-string (unparse-version core-segment))) - (setf (slot-value component 'version) (list core-string value)) - (values core-string value)) - (component-version component)))) - - ;; Adapt any existing implementation of COMPONENT-VERSION to the new - ;; interface. - (defmethod component-version :around ((component component)) - (let ((next-values (multiple-value-list (call-next-method)))) - (if (and (first next-values) (null (second next-values))) - (values (first next-values) (first next-values)) - (values-list next-values)))) - - (defmethod (setf component-version) :around (value (component component)) - (declare (ignore value)) - (let ((next-values (multiple-value-list (call-next-method)))) - (if (and (first next-values) (null (second next-values))) - (component-version component) - (values-list next-values))))) + ;; string) stored. + (let ((new-version (make-version raw-version))) + (setf (slot-value component 'version) new-version) + (values (version-string new-version) new-version))) + (uiop:version + (values (version-string raw-version) raw-version))))) + + (defmethod (setf component-version) ((value string) (component component)) + "Set the VERSION slot of component." + (setf (slot-value component 'version) + (make-version value :class (component-version-class component))) + ;; It's tempting to return (VALUES VALUE VALUE-AS-VERSION) here, but that + ;; does not seem to be allowed under 5.1.2.9 of the spec. + value) + (defmethod (setf component-version) ((value null) (component component)) + (setf (slot-value component 'version) nil) + value) + (defmethod (setf component-version) ((value uiop:version) (component component)) + (setf (slot-value component 'version) value) + value)) ;;;; Component hierarchy within a system diff --git a/uiop/version.lisp b/uiop/version.lisp index bf73e28c..dcba7602 100644 --- a/uiop/version.lisp +++ b/uiop/version.lisp @@ -3,6 +3,7 @@ (:use :uiop/common-lisp :uiop/package :uiop/utility) (:export #:*uiop-version* + #:make-version #:version #:version-string-invalid-error #:version-pre-release-p #:version-pre-release-for #:version-next #:version-string #:semantic-version #:default-version @@ -46,22 +47,35 @@ (:documentation "Returns the next version after VERSION. The returned version must not be a pre-release.") (:method ((version null)) - nil)) + nil) + (:method ((version string)) + (version-next (make-version version)))) (defgeneric version-pre-release-p (version) - (:documentation "Returns non-NIL if VERSION is a pre-release.")) + (:documentation "Returns non-NIL if VERSION is a pre-release.") + (:method ((version string)) + (version-pre-release-p (make-version version)))) (defgeneric version-pre-release-for (version) (:documentation "If VERSION is a pre-release, returns an version specifier -stating for which version it is a pre-release.")) +stating for which version it is a pre-release.") + (:method ((version string)) + (version-pre-release-for (make-version version)))) (when (and (symbol-function 'version<) (not (typep (symbol-function 'version<) 'generic-function))) ;; ASDF 3.4: Turned from function to generic function. Only conditionally ;; making it unbound because this is an extension point for the user and we ;; don't want to gratuitously remove their methods. (fmakunbound 'version<)) - (defgeneric version< (version-1 version-2) - (:documentation "Returns non-NIL if VERSION-1 is ordered before VERSION-2.")) + (defgeneric version< (version1 version2) + (:documentation "Returns non-NIL if VERSION2 is strictly newer than VERSION1.") + (:method ((version1 string) version2) + (version< (make-version version1) version2)) + (:method (version1 (version2 string)) + (version< version1 (make-version version2)))) (defgeneric version-string (version) - (:documentation "Return a string that represents VERSION.")) + (:documentation "Return a string that represents VERSION.") + (:method ((version string)) + ;; Round trip instead of returning VERSION, in case VERSION is invalid. + (version-string (make-version version)))) (defun version<= (version1 version2) "Given two version strings, return T if the second is newer or the same" @@ -280,14 +294,7 @@ segment can consist of at most two identifiers. The first must be \"alpha\", (equal "beta" (first pre-release-segment)) (equal "rc" (first pre-release-segment))) (integerp (second pre-release-segment)))) - (invalid "The pre-release segment must be absent or consist of \"alpha\", \"beta\", or \"rc\", optionally followed by an integer."))))) - - (defmethod version-next ((version string)) - (version-next (make-version version))) - (defmethod version< ((version1 string) version2) - (version< (make-version version1) version2)) - (defmethod version< (version1 (version2 string)) - (version< version1 (make-version version2)))) + (invalid "The pre-release segment must be absent or consist of \"alpha\", \"beta\", or \"rc\", optionally followed by an integer.")))))) (with-upgradability () (define-condition deprecated-function-condition (condition) @@ -341,11 +348,14 @@ various levels of deprecation, return the current level of deprecation as per WI that is the highest level that has a declared version older than the specified version. Each start version for a level of deprecation can be specified by a keyword argument, or if left unspecified, will be the VERSION-NEXT of the immediate lower level of deprecation." - (cond - ((and delete (version<= delete version)) :delete) - ((and error (version<= error version)) :error) - ((and warning (version<= warning version)) :warning) - ((and style-warning (version<= style-warning version)) :style-warning))) + (let ((version (if (version-pre-release-p version) + (version-pre-release-for version) + version))) + (cond + ((and delete (version<= delete version)) :delete) + ((and error (version<= error version)) :error) + ((and warning (version<= warning version)) :warning) + ((and style-warning (version<= style-warning version)) :style-warning)))) (defmacro with-deprecation ((level) &body definitions) "Given a deprecation LEVEL (a form to be EVAL'ed at macro-expansion time), instrument the -- GitLab From 34aa98d0c53859054640d33c3900ccdcb5f88ae1 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 18:14:59 -0500 Subject: [PATCH 22/49] Implement (most) of constraint checking --- component.lisp | 31 +++---- find-component.lisp | 9 +- interface.lisp | 1 - operate.lisp | 2 +- parse-defsystem.lisp | 68 +++------------ system.lisp | 2 +- test/test-version.script | 6 +- uiop/backward-driver.lisp | 4 +- uiop/version.lisp | 179 +++++++++++++++++++++++++++++++------- 9 files changed, 185 insertions(+), 117 deletions(-) diff --git a/component.lisp b/component.lisp index 31c3ecd3..867fbf44 100644 --- a/component.lisp +++ b/component.lisp @@ -39,13 +39,7 @@ #:defsystem-depends-on ; This symbol retained for backward compatibility. #:sideway-dependencies #:if-feature #:in-order-to #:inline-methods #:relative-pathname #:absolute-pathname #:operation-times #:around-compile - #:%encoding #:properties #:component-properties #:parent) - (:shadow - ;; UIOP started exporting VERSION in ASDF 3.4. VERSION is also the name of a - ;; slot in COMPONENT. Shadow VERSION so that we don't lose the value of that - ;; slot on upgrades. Otherwise, we'd need to - ;; UPDATE-INSTANCE-FOR-REDEFINED-CLASS. - #:version)) + #:%encoding #:properties #:component-properties #:parent)) (in-package :asdf/component) (with-upgradability () @@ -72,8 +66,8 @@ Use asdf-encodings to support more encodings.")) as the specified VERSION, which must be a string of dot-separated natural numbers, or NIL.")) (defgeneric component-version (component) (:documentation "Return the version of a COMPONENT in two VALUES. The first -value is a string that specifies the version, or NIL. The second value is -the UIOP:VERSION instance that is suitable for use with UIOP:VERSION<, or NIL.")) +value is a string that specifies the version, or NIL. The second value is the +VERSION-OBJECT instance that is suitable for use with UIOP:VERSION<, or NIL.")) (defgeneric (setf component-version) (new-version component) (:documentation "Updates the version of a COMPONENT.")) (defgeneric component-version-class (component) @@ -172,8 +166,8 @@ The return value is a list of component NAMES; a list of strings." (defmethod component-version ((component component)) "The VERSION slot of COMPONENT may be NIL, unbound, a string, or a -UIOP:VERSION object. If it's a string, update it to be a UIOP:VERSION object -and return it. If it's a UIOP:VERSION object, return it. Else, return NIL." +VERSION-OBJECT. If it's a string, update it to be a VERSION-OBJECT and return +it. If it's a VERSION-OBJECT object, return it. Else, return NIL." (if-let (raw-version (and (slot-boundp component 'version) (slot-value component 'version))) (typecase raw-version @@ -184,7 +178,7 @@ and return it. If it's a UIOP:VERSION object, return it. Else, return NIL." (let ((new-version (make-version raw-version))) (setf (slot-value component 'version) new-version) (values (version-string new-version) new-version))) - (uiop:version + (version-object (values (version-string raw-version) raw-version))))) (defmethod (setf component-version) ((value string) (component component)) @@ -197,7 +191,7 @@ and return it. If it's a UIOP:VERSION object, return it. Else, return NIL." (defmethod (setf component-version) ((value null) (component component)) (setf (slot-value component 'version) nil) value) - (defmethod (setf component-version) ((value uiop:version) (component component)) + (defmethod (setf component-version) ((value version-object) (component component)) (setf (slot-value component 'version) value) value)) @@ -356,14 +350,11 @@ this compilation, or check its results, etc.")) (return-from version-satisfies nil)) (version-satisfies (nth-value 1 (component-version c)) version)) + (defmethod version-satisfies ((cver version-object) version-constraint) + (version-constraint-satisfied-p cver version-constraint)) + (defmethod version-satisfies ((cver string) version) - (if (nth-value 1 (parse-version version)) - ;; The required VERSION has a pre-release segment, do not ignore - ;; pre-release segments in CVER. - (version<= version cver) - ;; No pre-release segment on VERSION. Ignore any pre-release - ;; information in CVER. - (version<= version (version-core-string cver))))) + (version-satisfies (make-version cver) version))) ;;; all sub-components (of a given type) diff --git a/find-component.lisp b/find-component.lisp index 53fa65d3..ffbcd9f4 100644 --- a/find-component.lisp +++ b/find-component.lisp @@ -114,10 +114,11 @@ in the context of COMPONENT")) :requires name)) (when version (unless (version-satisfies comp version) - (error 'missing-dependency-of-version - :required-by component - :version version - :requires name))) + (cerror "Continue anyways" + 'missing-dependency-of-version + :required-by component + :version version + :requires name))) comp)) (retry () :report (lambda (s) diff --git a/interface.lisp b/interface.lisp index 5f63e099..f2d322b1 100644 --- a/interface.lisp +++ b/interface.lisp @@ -72,7 +72,6 @@ #:component-system #:component-encoding #:component-external-format - #:normalize-component-version #:system-description #:system-long-description #:system-author diff --git a/operate.lisp b/operate.lisp index ccd66561..d54f0e07 100644 --- a/operate.lisp +++ b/operate.lisp @@ -92,7 +92,7 @@ But do NOT depend on it, for this is deprecated behavior.")) (defmethod operate :before ((operation operation) (component component) &key version) (unless (version-satisfies component version) - (error 'missing-component-of-version :requires component :version version)) + (cerror "Continue anyways" 'missing-component-of-version :requires component :version version)) (record-dependency nil operation component)) (defmethod operate ((operation operation) (component component) diff --git a/parse-defsystem.lisp b/parse-defsystem.lisp index fe269233..7a2d81d7 100644 --- a/parse-defsystem.lisp +++ b/parse-defsystem.lisp @@ -21,8 +21,6 @@ #:known-system-with-bad-secondary-system-names-p #:sysdef-error-component #:check-component-input #:explain - ;; For extending version strings - #:normalize-component-version ;; for extending the component types #:compute-component-children #:class-for-type)) @@ -147,7 +145,7 @@ Please only define ~S and secondary systems with a name starting with ~S (e.g. ~ (pushnew pathname (cdr cell) :test 'pathname-equal) (values))) - (defun* (parse-version-pointer) (form &key pathname) + (defun parse-version-pointer (form &key pathname) "Given a form used as a :version specification, in the context of a system definition in a file at PATHNAME, attempt to read the form as part of ASDF's mini-DSL for reading version information from another file. If FORM is not a @@ -169,54 +167,7 @@ specifying the pathname that was used to derive the return value, if any." path)))) (otherwise form)) - form)) - - ;; 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. - (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)) - (invalid-parse (control &rest args) - (unless (if-let (target (find-component parent component)) (builtin-system-p target)) - (apply 'warn control args) - (invalid)))) - (if-let (v (typecase form - ((or string null) form) - (real - (invalid "Substituting a string") - (format nil "~D" form)) ;; 1.0 becomes "1.0" - (cons - ;; We shouldn't ever get here now that parsing version - ;; pointers happens before normalizing the version, but - ;; leave for backwards compatibility. Consider removing in - ;; ASDF 4. - (multiple-value-bind (version-form additional-input-file) - (parse-version-pointer form :pathname pathname) - (when additional-input-file - (record-additional-system-input-file additional-input-file component parent)) - version-form)) - (t - (invalid)))) - (multiple-value-bind (core-segment pre-release-segment build-segment) - (parse-version v #'invalid-parse) - (if core-segment - ;; Store both the core segment (which we use for version - ;; comparisons) and the full version. This prevents calls to - ;; PARSE-VERSION from within COMPONENT-VERSION. - (list (unparse-version core-segment) - (unparse-version core-segment pre-release-segment build-segment)) - (invalid)))))) - - (defgeneric* (normalize-component-version) (component form &key pathname parent) - (:documentation "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 object that can be stored in the -COMPONENT's VERSION slot.") - (:method ((component component) form &key pathname parent) - (normalize-version form :pathname pathname :component component :parent parent)))) + form))) ;;; "inline methods" @@ -340,7 +291,7 @@ children.")) ;; remove-plist-keys form. important to keep them in sync components pathname perform explain output-files operation-done-p weakly-depends-on depends-on serial - do-first if-component-dep-fails version + do-first if-component-dep-fails version version-class ;; list ends &allow-other-keys) options (declare (ignore perform explain output-files operation-done-p builtin-system-p)) @@ -352,14 +303,19 @@ children.")) (class-for-type parent type)))) (error 'duplicate-names :name name)) (when do-first (error "DO-FIRST is not supported anymore as of ASDF 3")) + (unless (null version-class) + (setf version-class (coerce-class version-class :package :asdf/interface + :super 'version-object))) (let* ((name (coerce-name name)) (args `(:name ,name :pathname ,pathname + ,@(unless (null version-class) + `(:version-class ,version-class)) ,@(when parent `(:parent ,parent)) ,@(remove-plist-keys '(:components :pathname :if-component-dep-fails :version :perform :explain :output-files :operation-done-p - :weakly-depends-on :depends-on :serial) + :weakly-depends-on :depends-on :serial :version-class) rest))) (component (find-component parent name)) (class (class-for-type parent type))) @@ -386,7 +342,11 @@ children.")) (record-additional-system-input-file additional-input-file component parent)))) ;; Don't use the accessor: kluge to avoid upgrade issue on CCL 1.8. ;; A better fix is required. - (setf (slot-value component 'version) version) + (setf (slot-value component 'version) + (if (null version) + nil + (apply #'make-version version + (unless (null version-class) (list :version-class version-class))))) (when (typep component 'parent-component) (setf (component-children component) (compute-component-children component components serial)) (compute-children-by-name component)) diff --git a/system.lisp b/system.lisp index 648b1e0f..bf68e1ea 100644 --- a/system.lisp +++ b/system.lisp @@ -201,7 +201,7 @@ the primary one." ;; ASDF4: Move this back into *system-virtual-slots*. We can't return the ;; slot directly as we want to mimic the result of COMPONENT-VERSION which ;; now returns two VALUES. - (defun* system-version (system) + (defun system-version (system) (let ((direct-version (multiple-value-list (component-version system)))) (if (first direct-version) (values-list direct-version) diff --git a/test/test-version.script b/test/test-version.script index 6868fa27..e71fd09b 100644 --- a/test/test-version.script +++ b/test/test-version.script @@ -8,15 +8,15 @@ (assert (version< "1.0.0-alpha" "1.0.0")) (assert (version< "1.0.0-alpha" "1.0.0-alpha.1")) -(assert (version< "1.0.0-alpha.1" "1.0.0-alpha.beta")) -(assert (version< "1.0.0-alpha.beta" "1.0.0-beta")) +(assert (version< "1.0.0-alpha.1" (make-version "1.0.0-alpha.beta" :class 'semantic-version))) +(assert (version< (make-version "1.0.0-alpha.beta" :class 'semantic-version) "1.0.0-beta")) (assert (version< "1.0.0-beta" "1.0.0-beta.2")) (assert (version< "1.0.0-beta.2" "1.0.0-beta.11")) (assert (version< "1.0.0-beta.11" "1.0.0-rc.1")) (assert (version< "1.0.0-rc.1" "1.0.0")) (DBG "Check that there is an ASDF version that correctly parses to a non-empty list") -(assert (consp (parse-version (asdf-version) 'error))) +(assert (not (null (make-version (asdf-version))))) (DBG "Check that ASDF is newer than 1.234") (assert-compare (version<= "1.234" (asdf-version))) (DBG "Check that ASDF is not a compatible replacement for 1.234") diff --git a/uiop/backward-driver.lisp b/uiop/backward-driver.lisp index 4a67992b..bf7e8a3f 100644 --- a/uiop/backward-driver.lisp +++ b/uiop/backward-driver.lisp @@ -63,7 +63,7 @@ If major versions differ, it's not compatible. If they are equal, then any later version is compatible, with later being determined by a lexicographical comparison of minor numbers. DEPRECATED." - (let ((x (parse-version provided-version nil)) - (y (parse-version required-version nil))) + (let ((x (uiop/version::%parse-version provided-version nil)) + (y (uiop/version::%parse-version required-version nil))) (and x y (= (car x) (car y)) (lexicographic<= '< (cdr y) (cdr x))))))) diff --git a/uiop/version.lisp b/uiop/version.lisp index dcba7602..d11e40bb 100644 --- a/uiop/version.lisp +++ b/uiop/version.lisp @@ -4,9 +4,10 @@ (:export #:*uiop-version* #:make-version - #:version #:version-string-invalid-error #:version-pre-release-p #:version-pre-release-for + #:version-object #:version-string-invalid-error #:version-pre-release-p #:version-pre-release-for #:version-next #:version-string #:semantic-version #:default-version + #:version-constraint-satisfied-p #:parse-version #:unparse-version #:version< #:version<= #:version= ;; version support, moved from uiop/utility #:next-version #:deprecated-function-condition #:deprecated-function-name ;; deprecation control @@ -16,16 +17,25 @@ (in-package :uiop/version) (with-upgradability () - (defparameter *uiop-version* "3.3.5.7")) - -;; Base version class and API. + (defparameter *fake-uiop-version* "3.4.0" + "ASDF has some logic in FIND-SYSTEM to ensure that an old version of UIOP +isn't returned. To do so, it looks at form '(2 2 2) in this file. Because old +versions of ASDF can't parse version strings with pre-release information, we +make sure this is always set to the non-pre-release version.") + (defparameter *uiop-version* "3.4.0-alpha.1")) + +;; Base version-object class and API. (with-upgradability () - (defclass version () + ;; Introduced in version 3.4. This can't be called VERSION because ASDF + ;; already exports a VERSION (a slot name for COMPONENT, why???). So let's + ;; not deal with changing VERSION's home package and all the messiness that + ;; would entail. + (defclass version-object () () (:documentation "The base class of version specifiers.")) - (defmethod print-object ((version version) stream) + (defmethod print-object ((version version-object) stream) (print-unreadable-object (version stream :type t :identity t) (format stream "~A" (version-string version)))) @@ -42,7 +52,23 @@ (%version-string condition) (%reason condition))))) (defun make-version (version-string &key (class 'default-version)) - (make-instance class :version-string version-string)) + (when (not (null version-string)) + (restart-case + (make-instance class :version-string version-string) + (continue () + :report "Return NIL as the version object." + nil) + (use-value (new-version-string) + :report "Retry parsing, with a new version string." + :interactive (lambda () + (format *query-io* "Enter a new version string: ") + (list (read-line *query-io*))) + (make-version new-version-string :class class))))) + + (defun ensure-version (maybe-version &key (class 'default-version)) + (if (stringp maybe-version) + (make-version maybe-version :class class) + maybe-version)) (defgeneric version-next (version) (:documentation "Returns the next version after VERSION. The returned version must not be a pre-release.") @@ -59,7 +85,7 @@ version must not be a pre-release.") stating for which version it is a pre-release.") (:method ((version string)) (version-pre-release-for (make-version version)))) - (when (and (symbol-function 'version<) + (when (and (fboundp 'version<) (not (typep (symbol-function 'version<) 'generic-function))) ;; ASDF 3.4: Turned from function to generic function. Only conditionally ;; making it unbound because this is an extension point for the user and we @@ -97,7 +123,7 @@ the second is also newer or the same." #\-) "List of all characters valid in pre-release and build metadata segments.") - (defclass semantic-version (version) + (defclass semantic-version (version-object) (core-segment pre-release-segment build-metadata-segment) @@ -296,6 +322,87 @@ segment can consist of at most two identifiers. The first must be \"alpha\", (integerp (second pre-release-segment)))) (invalid "The pre-release segment must be absent or consist of \"alpha\", \"beta\", or \"rc\", optionally followed by an integer.")))))) +(with-upgradability () + (defun simple-version-constraint-p (constraint) + (and (listp constraint) + (and (= (length constraint) 2)) + (member (first constraint) '(:>= :> :<= :< := :/=)) + (or (stringp (second constraint)) + (typep (second constraint) 'version-object)))) + (defun simple-version-constraint-satisfied-p (operator version requested + &key (strip-pre-release-p (not (version-pre-release-p requested)))) + (let ((version (if (and strip-pre-release-p (version-pre-release-p version)) + (version-pre-release-for version) + version))) + (ecase operator + (:>= + (not (version< version requested))) + (:> + (version< requested version)) + (:<= + (not (version< requested version))) + (:< + (version< version requested)) + (:= + (version= version requested)) + (:/= + (not (version= version requested)))))) + + (defun compound-version-constraint-p (constraint) + (and (listp constraint) + (member (first constraint) '(:and :or)))) + (defun compound-version-constraint-satisfied-p (operator version subcs + &rest args + &key strip-pre-release-p) + (declare (ignore strip-pre-release-p)) + (ecase operator + (:and + (every (lambda (subc) (apply #'version-constraint-satisfied-p version subc args)) + subcs)) + (:or + (some (lambda (subc) (apply #'version-constraint-satisfied-p version subc args)) + subcs)))) + + (defun compatible-version-constraint-p (constraint) + (or (and (listp constraint) + (and (= (length constraint) 2)) + (eql (first constraint) :compatible) + (or (stringp (second constraint)) + (typep (second constraint) 'version-object))) + (stringp constraint) + (typep constraint 'version-object))) + (defun compatible-version-constraint-satisfied-p (version requested + &rest args + &key compatible-versions + (strip-pre-release-p (not (version-pre-release-p requested)))) + (let ((version (if (and strip-pre-release-p (version-pre-release-p version)) + (version-pre-release-for version) + version))) + (and (not (version< version requested)) + (or (null compatible-versions) + (apply #'version-constraint-satisfied-p requested compatible-versions + (remove-plist-key :compatible-versions args)))))) + + (defun version-constraint-satisfied-p (version constraint &rest args &key strip-pre-release-p) + (declare (ignore strip-pre-release-p)) + (let ((version (ensure-version version))) + (cond + ((simple-version-constraint-p constraint) + (apply #'simple-version-constraint-satisfied-p + (first constraint) version + (ensure-version (second constraint) + :class (class-of version)) + args)) + ((compatible-version-constraint-p constraint) + (let ((requested (ensure-version (if (listp constraint) (second constraint) constraint) + :class (class-of version)))) + (apply #'compatible-version-constraint-satisfied-p version requested args))) + ((compound-version-constraint-p constraint) + (apply #'compound-version-constraint-satisfied-p + (first constraint) version (rest constraint) + args)) + (t t))))) + (with-upgradability () (define-condition deprecated-function-condition (condition) ((name :initarg :name :reader deprecated-function-name))) @@ -417,12 +524,41 @@ from instrumentation by enclosing it in a PROGN." ;; All of these were deprecated in 3.4 (with-upgradability () + ;; These implement the actual logic of the deprecated functions. Doing it + ;; this way ensures that we don't get style warnings when loading UIOP + ;; itself. + (defun %unparse-version (version-list) + (format nil "~{~D~^.~}" version-list)) + (defun %parse-version (version-string &optional on-error) + (block nil + (unless (stringp version-string) + (call-function on-error "~S: ~S is not a string" 'parse-version version-string) + (return)) + (unless (loop :for prev = nil :then c :for c :across version-string + :always (or (digit-char-p c) + (and (eql c #\.) prev (not (eql prev #\.)))) + :finally (return (and c (digit-char-p c)))) + (call-function on-error "~S: ~S doesn't follow asdf version numbering convention" + 'parse-version version-string) + (return)) + (let* ((version-list + (mapcar #'parse-integer (split-string version-string :separator "."))) + (normalized-version (%unparse-version version-list))) + (unless (equal version-string normalized-version) + (call-function on-error "~S: ~S contains leading zeros" 'parse-version version-string)) + version-list))) + (defun %next-version (version) + (when version + (let ((version-list (%parse-version version))) + (incf (car (last version-list))) + (%unparse-version version-list)))) + (with-deprecation ((version-deprecation *uiop-version* :style-warning "3.4" :delete "4.0")) (defun unparse-version (version-list) "DEPRECATED. Use VERSION-STRING instead. From a parsed version (a list of natural numbers), compute the version string" - (format nil "~{~D~^.~}" version-list)) + (%unparse-version version-list)) (defun parse-version (version-string &optional on-error) "DEPRECATED. Use MAKE-VERSION instead. @@ -435,30 +571,11 @@ When invalid, ON-ERROR is called as per CALL-FUNCTION before to return NIL, with format arguments explaining why the version is invalid. ON-ERROR is also called if the version is not canonical in that it doesn't print back to itself, but the list is returned anyway." - (block nil - (unless (stringp version-string) - (call-function on-error "~S: ~S is not a string" 'parse-version version-string) - (return)) - (unless (loop :for prev = nil :then c :for c :across version-string - :always (or (digit-char-p c) - (and (eql c #\.) prev (not (eql prev #\.)))) - :finally (return (and c (digit-char-p c)))) - (call-function on-error "~S: ~S doesn't follow asdf version numbering convention" - 'parse-version version-string) - (return)) - (let* ((version-list - (mapcar #'parse-integer (split-string version-string :separator "."))) - (normalized-version (unparse-version version-list))) - (unless (equal version-string normalized-version) - (call-function on-error "~S: ~S contains leading zeros" 'parse-version version-string)) - version-list))) + (%parse-version version-string on-error)) (defun next-version (version) "DEPRECATED. Use VERSION-NEXT instead. When VERSION is not nil, it is a string, then parse it as a version, compute the next version and return it as a string." - (when version - (let ((version-list (parse-version version))) - (incf (car (last version-list))) - (unparse-version version-list)))))) + (%next-version version)))) -- GitLab From ec7b16ef2ade685995719933f6e955dcbafcf6db Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 18:32:11 -0500 Subject: [PATCH 23/49] Make version bump scripts handle pre-release info --- asdf.asd | 2 +- bin/bump-version | 6 +++--- doc/asdf.texinfo | 4 ++-- header.lisp | 2 +- tools/version.lisp | 2 +- upgrade.lisp | 2 +- version.lisp-expr | 2 +- 7 files changed, 10 insertions(+), 10 deletions(-) diff --git a/asdf.asd b/asdf.asd index e61aa0f4..027e0539 100644 --- a/asdf.asd +++ b/asdf.asd @@ -93,7 +93,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "3.3.5.7" ;; to be automatically updated by make bump-version + :version "3.4.0-alpha.1" ;; to be automatically updated by make bump-version :depends-on () :components ((:module "build" :components ((:file "asdf")))) . #-asdf3 () #+asdf3 diff --git a/bin/bump-version b/bin/bump-version index f619c430..e09c90bf 100755 --- a/bin/bump-version +++ b/bin/bump-version @@ -67,12 +67,12 @@ sub transform_files { my $file = $entry[0]; print STDERR "Modifying file $file\n"; print STDERR "Prefix is $entry[1], suffix is $entry[2]\n"; - my $regex = "(" . quotemeta($entry[1]) . ")" . "((\\d+\\.)+\\d+)" . "(" . quotemeta($entry[2]) .")"; + my $regex = "(" . quotemeta($entry[1]) . ")" . "((\\d+\\.)+\\d+(\\-[a-zA-Z0-9_.-]+)?)" . "(" . quotemeta($entry[2]) .")"; my $filename = $asdf_dir . $file; my $data = read_text($filename); - my $count = ($data =~ s/$regex/$1$new$4/g); + my $count = ($data =~ s/$regex/$1$new$5/g); if ($count == 0) { - die "Unable to replace $regex with $1$new$4"; + die "Unable to replace $regex with $1$new$5"; } # print STDERR "Writing $data to $filename\n"; write_text($filename, $data); diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index b3ef9f8f..94dd0483 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -65,7 +65,7 @@ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. @titlepage @title ASDF: Another System Definition Facility -@subtitle Manual for Version 3.3.5.7 +@subtitle Manual for Version 3.4.0-alpha.1 @c The following two commands start the copyright page. @page @vskip 0pt plus 1filll @@ -82,7 +82,7 @@ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. @node Top, Introduction, (dir), (dir) @top ASDF: Another System Definition Facility @ifnottex -Manual for Version 3.3.5.7 +Manual for Version 3.4.0-alpha.1 @end ifnottex diff --git a/header.lisp b/header.lisp index 31054441..b98e8e96 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; Package: CL-USER ; buffer-read-only: t; -*- -;;; This is ASDF 3.3.5.7: Another System Definition Facility. +;;; This is ASDF 3.4.0-alpha.1: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to . diff --git a/tools/version.lisp b/tools/version.lisp index 31128127..017f0006 100644 --- a/tools/version.lisp +++ b/tools/version.lisp @@ -95,7 +95,7 @@ (defun version-transformer (new-version file prefix suffix &optional dont-warn) (let* ((qprefix (cl-ppcre:quote-meta-chars prefix)) - (versionrx "([0-9]+(\\.[0-9]+)+)") + (versionrx "([0-9]+(\\.[0-9]+)+(-[a-zA-Z0-9_.-]+)?)") (qsuffix (cl-ppcre:quote-meta-chars suffix)) (regex (strcat "(" qprefix ")(" versionrx ")(" qsuffix ")")) (replacement diff --git a/upgrade.lisp b/upgrade.lisp index 81f03161..47931270 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -97,7 +97,7 @@ previously-loaded version of ASDF." ;; "3.4.5.67" would be a development version in the official branch, on top 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 "3.3.5.7") + (asdf-version "3.4.0-alpha.1") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) diff --git a/version.lisp-expr b/version.lisp-expr index 015c0944..8428a7d5 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1,2 +1,2 @@ -"3.3.5.7" +"3.4.0-alpha.1" -- GitLab From e38b268e2e63cef6172513c8c8191c0cb0352998 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 19:01:20 -0500 Subject: [PATCH 24/49] Add a full-version.lisp-expr file Versions >= 3.4 can use this to determine if an upgrade should happen. Earlier versions need to use version.lisp-expr --- Makefile | 8 ++++---- README.md | 5 ++++- asdf.asd | 4 ++-- bin/bump-version | 27 +++++++++++++++++++-------- find-system.lisp | 3 ++- full-version.lisp-expr | 2 ++ tools/release.lisp | 2 +- tools/version.lisp | 20 +++++++++++++------- version.lisp-expr | 5 ++++- 9 files changed, 51 insertions(+), 25 deletions(-) create mode 100644 full-version.lisp-expr diff --git a/Makefile b/Makefile index 7d621589..99c1f340 100644 --- a/Makefile +++ b/Makefile @@ -32,7 +32,7 @@ else endif endif -version := $(shell cat "version.lisp-expr") +version := $(shell cat "full-version.lisp-expr") #$(info $$version is [${version}]) version := $(patsubst "%",%,$(version)) #$(info $$version is [${version}]) @@ -119,8 +119,8 @@ load: build/asdf.lisp install: archive bump: bump-version - git commit -a -m "Bump version to $$(eval a=$$(cat version.lisp-expr) ; echo $$a)" - temp=$$(cat version.lisp-expr); temp="$${temp%\"}"; temp="$${temp#\"}"; git tag $$temp + git commit -a -m "Bump version to $$(eval a=$$(cat full-version.lisp-expr) ; echo $$a)" + temp=$$(cat full-version.lisp-expr); temp="$${temp%\"}"; temp="$${temp#\"}"; git tag $$temp bump-version: build/asdf.lisp ./bin/bump-version ${v} @@ -143,7 +143,7 @@ archive: build/asdf.lisp rm -r build/$(UIOPDIR) $(eval ASDFDIR := "asdf-$(version)") mkdir -p build/$(ASDFDIR) # asdf-defsystem tarball - cp -pHux build/asdf.lisp asdf.asd version.lisp-expr header.lisp README.md ${defsystem_lisp} build/$(ASDFDIR) + cp -pHux build/asdf.lisp asdf.asd full-version.lisp-expr version.lisp-expr header.lisp README.md ${defsystem_lisp} build/$(ASDFDIR) tar zcf "build/asdf-defsystem-${version}.tar.gz" -C build $(ASDFDIR) rm -r build/$(ASDFDIR) git archive --worktree-attributes --prefix="asdf-$(version)/" --format=tar -o "build/asdf-${version}.tar" ${version} #asdf-all tarball diff --git a/README.md b/README.md index 69312fb5..0704f0fb 100644 --- a/README.md +++ b/README.md @@ -276,7 +276,10 @@ How do I navigate this source tree? the lisp scripting variants of the build system. * [version.lisp-expr](version.lisp-expr) - * The current version. Bumped up every time the code changes, using: + [full-version.lisp-expr](full-version.lisp-expr) + * The current version. The `full-version.lisp-expr` file contains + pre-release information, `version.lisp-expr` does not. Bumped up every + time the code changes, using: make bump diff --git a/asdf.asd b/asdf.asd index 027e0539..a286ab7c 100644 --- a/asdf.asd +++ b/asdf.asd @@ -23,7 +23,7 @@ ;; and compulsory to sort them in defsystem-depends-on order. #+asdf3 (defsystem "asdf/prelude" - :version (:read-file-form "version.lisp-expr") + :version (:read-file-form "full-version.lisp-expr") :around-compile call-without-redefinition-warnings ;; we need be the same as uiop :encoding :utf-8 :components ((:file "header"))) @@ -51,7 +51,7 @@ :bug-tracker "https://launchpad.net/asdf/" :mailto "asdf-devel@common-lisp.net" :source-control (:git "git://common-lisp.net/projects/asdf/asdf.git") - :version (:read-file-form "version.lisp-expr") + :version (:read-file-form "full-version.lisp-expr") :build-operation monolithic-concatenate-source-op :build-pathname "build/asdf" ;; our target :around-compile call-without-redefinition-warnings ;; we need be the same as uiop diff --git a/bin/bump-version b/bin/bump-version index e09c90bf..63d29f2b 100755 --- a/bin/bump-version +++ b/bin/bump-version @@ -4,6 +4,7 @@ use FindBin; use Getopt::Long; our $old; our $new; +our $new_no_pre_release; our $usage = 0; &GetOptions("help"=>\$usage, @@ -18,16 +19,17 @@ if ($usage) { } our $asdf_dir = $FindBin::RealBin . "/../"; -our $file = $asdf_dir . "version.lisp-expr"; +our $file = $asdf_dir . "full-version.lisp-expr"; our @transform_ref = ( - [ "version.lisp-expr", "\"", "\"" ], - [ "uiop/version.lisp", "(defparameter *uiop-version* \"", "\")" ], - [ "asdf.asd", " :version \"", "\" ;; to be automatically updated by make bump-version" ], - [ "header.lisp", "This is ASDF ", ": Another System Definition Facility." ], - [ "upgrade.lisp", "(asdf-version \"", "\")" ], - [ "doc/asdf.texinfo", "Manual for Version ", "" ], ); + [ "version.lisp-expr", "\"", "\"", 1], + [ "full-version.lisp-expr", "\"", "\"", 0], + [ "uiop/version.lisp", "(defparameter *uiop-version* \"", "\")", 0 ], + [ "asdf.asd", " :version \"", "\" ;; to be automatically updated by make bump-version", 0 ], + [ "header.lisp", "This is ASDF ", ": Another System Definition Facility.", 0 ], + [ "upgrade.lisp", "(asdf-version \"", "\")", 0 ], + [ "doc/asdf.texinfo", "Manual for Version ", "", 0 ], ); if ($#ARGV == 1) { $old = $ARGV[0]; @@ -40,6 +42,9 @@ if ($#ARGV == 1) { $new = bump_asdf_version($old); } +$new_no_pre_release = $new; +$new_no_pre_release =~ s/-.*//g; + print STDERR "Bumping from $old to $new\n"; transform_files(); @@ -65,12 +70,18 @@ sub transform_files { foreach my $entryptr (@transform_ref) { my @entry = @{$entryptr}; my $file = $entry[0]; + my $strip_pre_release = $entry[3]; print STDERR "Modifying file $file\n"; print STDERR "Prefix is $entry[1], suffix is $entry[2]\n"; my $regex = "(" . quotemeta($entry[1]) . ")" . "((\\d+\\.)+\\d+(\\-[a-zA-Z0-9_.-]+)?)" . "(" . quotemeta($entry[2]) .")"; my $filename = $asdf_dir . $file; my $data = read_text($filename); - my $count = ($data =~ s/$regex/$1$new$5/g); + my $count; + if ($strip_pre_release) { + $count = ($data =~ s/$regex/$1$new_no_pre_release$5/g); + } else { + $count = ($data =~ s/$regex/$1$new$5/g); + } if ($count == 0) { die "Unable to replace $regex with $1$new$5"; } diff --git a/find-system.lisp b/find-system.lisp index 0980a2cc..dc88c77d 100644 --- a/find-system.lisp +++ b/find-system.lisp @@ -149,7 +149,8 @@ Do NOT try to load a .asd file directly with CL:LOAD. Always use ASDF:LOAD-ASD." (null pathname) (let* ((asdfp (equal name "asdf")) ;; otherwise, it's uiop (version-pathname - (subpathname pathname "version" :type (if asdfp "lisp-expr" "lisp"))) + (subpathname pathname (if asdfp "full-version" "version") + :type (if asdfp "lisp-expr" "lisp"))) (version (and (probe-file* version-pathname :truename nil) (read-file-form version-pathname :at (if asdfp '(0) '(2 2 2))))) (old-version (asdf-version))) diff --git a/full-version.lisp-expr b/full-version.lisp-expr new file mode 100644 index 00000000..8428a7d5 --- /dev/null +++ b/full-version.lisp-expr @@ -0,0 +1,2 @@ +"3.4.0-alpha.1" + diff --git a/tools/release.lisp b/tools/release.lisp index 8303440e..76d01463 100644 --- a/tools/release.lisp +++ b/tools/release.lisp @@ -77,7 +77,7 @@ (defun asdf-defsystem-files () "list files in asdf/defsystem" (list* "build/asdf.lisp" ;; for bootstrap purposes - "asdf.asd" "version.lisp-expr" "header.lisp" + "asdf.asd" "full-version.lisp-expr" "header.lisp" (system-source-files "asdf/defsystem"))) (defun asdf-defsystem-name () (format nil "asdf-defsystem-~A" (version-from-file))) diff --git a/tools/version.lisp b/tools/version.lisp index 017f0006..15e295a1 100644 --- a/tools/version.lisp +++ b/tools/version.lisp @@ -10,8 +10,9 @@ (defun version-from-file (&optional commit) (if commit - (nth-value 2 (git `(show (,commit":version.lisp-expr")) :output :form)) - (safe-read-file-form (pn "version.lisp-expr")))) + (or (ignore-errors (nth-value 2 (git `(show (,commit":full-version.lisp-expr")) :output :form))) + (nth-value 2 (git `(show (,commit":version.lisp-expr")) :output :form))) + (safe-read-file-form (pn "full-version.lisp-expr")))) (defun debian-version-from-file (&optional commit) (match (if commit @@ -40,7 +41,8 @@ ;;; Bumping the version of ASDF (defparameter *versioned-files* - '(("version.lisp-expr" "\"" "\"") + '(("full-version.lisp-expr" "\"" "\"") + ("full-version.lisp-expr" "\"" "\"" t) ("uiop/version.lisp" "(defparameter *uiop-version* \"" "\")") ("asdf.asd" " :version \"" "\" ;; to be automatically updated by make bump-version") ("header.lisp" "This is ASDF " ": Another System Definition Facility.") @@ -93,7 +95,10 @@ (format t "done.~%")))) (success)) -(defun version-transformer (new-version file prefix suffix &optional dont-warn) +(defun version-transformer (new-version file prefix suffix &key dont-warn strip-pre-release) + (let ((--position (position #\- new-version))) + (when (and strip-pre-release (not (null --position))) + (setf new-version (subseq new-version 0 --position)))) (let* ((qprefix (cl-ppcre:quote-meta-chars prefix)) (versionrx "([0-9]+(\\.[0-9]+)+(-[a-zA-Z0-9_.-]+)?)") (qsuffix (cl-ppcre:quote-meta-chars suffix)) @@ -107,8 +112,9 @@ (warn "Missing version in ~A" (file-namestring file))) (values new-text foundp))))) -(defun transform-file (new-version file prefix suffix) - (maybe-replace-file (pn file) (version-transformer new-version file prefix suffix))) +(defun transform-file (new-version file prefix suffix &optional strip-pre-release) + (maybe-replace-file (pn file) (version-transformer new-version file prefix suffix + :strip-pre-release strip-pre-release))) (defun transform-files (new-version) (loop :for f :in *versioned-files* :do (apply 'transform-file new-version f)) @@ -118,7 +124,7 @@ (let ((lines (read-file-lines (pn file)))) (dolist (l lines (progn (warn "Couldn't find a match in ~A" file) nil)) (multiple-value-bind (new-text foundp) - (funcall (version-transformer new-version file prefix suffix t) l) + (funcall (version-transformer new-version file prefix suffix :dont-warn t) l) (when foundp (format t "Found a match:~% ==> ~A~%Replacing with~% ==> ~A~%~%" l new-text) diff --git a/version.lisp-expr b/version.lisp-expr index 8428a7d5..d8e9dc0c 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1,2 +1,5 @@ -"3.4.0-alpha.1" +;; This must contain the version without pre-release info, as versions of ASDF +;; earlier than 3.4 use this file to determine if they should self-upgrade and +;; they are unable to parse pre-release info. +"3.4.0" -- GitLab From a424e4d175587d58f614e676018f2dacb35ee891 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 22:07:54 -0500 Subject: [PATCH 25/49] Add cases for NULL arguments to VERSION< --- uiop/version.lisp | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/uiop/version.lisp b/uiop/version.lisp index d11e40bb..94a481d6 100644 --- a/uiop/version.lisp +++ b/uiop/version.lisp @@ -96,7 +96,19 @@ stating for which version it is a pre-release.") (:method ((version1 string) version2) (version< (make-version version1) version2)) (:method (version1 (version2 string)) - (version< version1 (make-version version2)))) + (version< version1 (make-version version2))) + (:method (version1 (version2 null)) + "This method doesn't make a lot of sense, but it it here to maintain +backward compatibility with the behavior of VERSION< prior to 3.4." + nil) + (:method ((version1 null) version2) + "This method doesn't make a lot of sense, but it it here to maintain +backward compatibility with the behavior of VERSION< prior to 3.4." + t) + (:method ((version1 null) (version2 null)) + "This method doesn't make a lot of sense, but it it here to maintain +backward compatibility with the behavior of VERSION< prior to 3.4." + nil)) (defgeneric version-string (version) (:documentation "Return a string that represents VERSION.") (:method ((version string)) -- GitLab From 97e6fe4964832c17b9d0a1b3c1bfb7bd046b769d Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 22:09:10 -0500 Subject: [PATCH 26/49] Remove a test for a deprecated function currently at ERROR level --- test/test-operation-classes.script | 19 ------------------- 1 file changed, 19 deletions(-) diff --git a/test/test-operation-classes.script b/test/test-operation-classes.script index 94095b66..1fcbb18f 100644 --- a/test/test-operation-classes.script +++ b/test/test-operation-classes.script @@ -58,25 +58,6 @@ (assert (make-operation 'my-good-operation)) - -;; This test exercises the backward-compatibility mechanism of operation, -;; whereby traditional unqualified operations are implicitly downward and sideward -(defclass trivial-operation (operation) ()) - -(assert-equal - (loop :for (o . c) :in (traverse 'trivial-operation '(:test-asdf/test-module-depend "quux")) - :collect (cons (type-of o) (component-find-path c))) - '((trivial-operation "test-asdf/test-module-depend" "file1") - (trivial-operation "test-asdf/test-module-depend" "quux" "file2") - (trivial-operation "test-asdf/test-module-depend" "quux" "file3mod" "file3") - (trivial-operation "test-asdf/test-module-depend" "quux" "file3mod") - (trivial-operation "test-asdf/test-module-depend" "quux"))) - -(operate 'trivial-operation 'test-asdf/test-module-depend) -;;; this test intended to catch a bug in operate :around method in operate.lisp, -;;; thanks to Jan Moringen [2014/08/10:rpg] -(operate (make-operation 'trivial-operation) 'test-asdf/test-module-depend) - ;;; operations should only be made by MAKE-OPERATION, and now we enforce this. (signals system-definition-error (make-instance 'load-op)) -- GitLab From 0a910d385096bc4de2af20d4f7750a6dd0ca2300 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 22:11:40 -0500 Subject: [PATCH 27/49] Get rid of an undefined function warning --- uiop/version.lisp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/uiop/version.lisp b/uiop/version.lisp index 94a481d6..0eaf0185 100644 --- a/uiop/version.lisp +++ b/uiop/version.lisp @@ -369,10 +369,10 @@ segment can consist of at most two identifiers. The first must be \"alpha\", (declare (ignore strip-pre-release-p)) (ecase operator (:and - (every (lambda (subc) (apply #'version-constraint-satisfied-p version subc args)) + (every (lambda (subc) (apply 'version-constraint-satisfied-p version subc args)) subcs)) (:or - (some (lambda (subc) (apply #'version-constraint-satisfied-p version subc args)) + (some (lambda (subc) (apply 'version-constraint-satisfied-p version subc args)) subcs)))) (defun compatible-version-constraint-p (constraint) @@ -392,7 +392,7 @@ segment can consist of at most two identifiers. The first must be \"alpha\", version))) (and (not (version< version requested)) (or (null compatible-versions) - (apply #'version-constraint-satisfied-p requested compatible-versions + (apply 'version-constraint-satisfied-p requested compatible-versions (remove-plist-key :compatible-versions args)))))) (defun version-constraint-satisfied-p (version constraint &rest args &key strip-pre-release-p) -- GitLab From 73a69235bc8b5512a6b57edeb1be6b718be669a5 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 22:24:52 -0500 Subject: [PATCH 28/49] Get rid of an undefined function warning --- uiop/version.lisp | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/uiop/version.lisp b/uiop/version.lisp index 0eaf0185..92dc468e 100644 --- a/uiop/version.lisp +++ b/uiop/version.lisp @@ -35,10 +35,6 @@ make sure this is always set to the non-pre-release version.") (:documentation "The base class of version specifiers.")) - (defmethod print-object ((version version-object) stream) - (print-unreadable-object (version stream :type t :identity t) - (format stream "~A" (version-string version)))) - (define-condition version-string-invalid-error (error) ((%version-string :initarg :version-string @@ -122,7 +118,11 @@ backward compatibility with the behavior of VERSION< prior to 3.4." "Given two version strings, return T if the first is newer or the same and the second is also newer or the same." (and (version<= version1 version2) - (version<= version2 version1)))) + (version<= version2 version1))) + + (defmethod print-object ((version version-object) stream) + (print-unreadable-object (version stream :type t :identity t) + (format stream "~A" (version-string version))))) ;; Semantic version class (with-upgradability () -- GitLab From c7c2c316f6a8cb211874a25b90275a58d9bc4545 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 22:25:13 -0500 Subject: [PATCH 29/49] Muffle some annoying notes on SBCL that we can't do anything about --- uiop/stream.lisp | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/uiop/stream.lisp b/uiop/stream.lisp index b0dd6cfd..4e3ac677 100644 --- a/uiop/stream.lisp +++ b/uiop/stream.lisp @@ -199,7 +199,10 @@ If OUTPUT is a PATHNAME, open the file and write to it, passing ELEMENT-TYPE to Otherwise, signal an error." (etypecase output (null - (with-output-to-string (stream nil :element-type element-type) (funcall function stream))) + ;; SBCL emits an annoying note here because it can't stack allocate the + ;; initial buffer if the element-type isn't known at compile time. + (locally (declare #+sbcl (sb-ext:muffle-conditions sb-ext:compiler-note)) + (with-output-to-string (stream nil :element-type element-type) (funcall function stream)))) ((eql t) (funcall function *standard-output*)) (stream @@ -390,8 +393,12 @@ Otherwise, using WRITE-SEQUENCE using a buffer of size BUFFER-SIZE." "Read the contents of the INPUT stream as a string" (let ((string (with-open-stream (input input) - (with-output-to-string (output nil :element-type element-type) - (copy-stream-to-stream input output :element-type element-type))))) + ;; SBCL emits an annoying note here because it can't stack + ;; allocate the initial buffer if the element-type isn't known at + ;; compile time. + (locally (declare #+sbcl (sb-ext:muffle-conditions sb-ext:compiler-note)) + (with-output-to-string (output nil :element-type element-type) + (copy-stream-to-stream input output :element-type element-type)))))) (if stripped (stripln string) string))) (defun slurp-stream-lines (input &key count) -- GitLab From 8cd8d7ad1841fcf0f7f824b7e447f267698f5068 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 22:37:44 -0500 Subject: [PATCH 30/49] Add :compatible-versions to system definitions --- component.lisp | 11 ++++++----- system.lisp | 17 +++++++++++++++-- uiop/version.lisp | 12 +++++++----- 3 files changed, 28 insertions(+), 12 deletions(-) diff --git a/component.lisp b/component.lisp index 867fbf44..ec67efe9 100644 --- a/component.lisp +++ b/component.lisp @@ -344,11 +344,12 @@ this compilation, or check its results, etc.")) (defmethod version-satisfies :around ((c t) (version null)) t) (defmethod version-satisfies ((c component) version) - (unless (and version (component-version c)) - (when version - (warn "Requested version ~S but ~S has no version" version c)) - (return-from version-satisfies nil)) - (version-satisfies (nth-value 1 (component-version c)) version)) + (let ((component-version (component-version c))) + (unless (and version component-version) + (when version + (warn "Requested version ~S but ~S has no version" version c)) + (return-from version-satisfies nil)) + (version-satisfies component-version version))) (defmethod version-satisfies ((cver version-object) version-constraint) (version-constraint-satisfied-p cver version-constraint)) diff --git a/system.lisp b/system.lisp index bf68e1ea..e7cda964 100644 --- a/system.lisp +++ b/system.lisp @@ -9,7 +9,7 @@ #:system-source-file #:system-source-directory #:system-relative-pathname #:system-description #:system-long-description #:system-author #:system-maintainer #:system-licence #:system-license - #:system-version + #:system-version #:system-compatible-versions #:definition-dependency-list #:definition-dependency-set #:system-defsystem-depends-on #:system-depends-on #:system-weakly-depends-on #:component-build-pathname #:build-pathname @@ -104,7 +104,10 @@ a SYSTEM is redefined and its class is modified.")) :initform nil) ;; these two are specially set in parse-component-form, so have no :INITARGs. (depends-on :reader system-depends-on :initform nil) - (weakly-depends-on :reader system-weakly-depends-on :initform nil)) + (weakly-depends-on :reader system-weakly-depends-on :initform nil) + ;; This slot added in ASDF 3.4 + (compatible-versions :reader system-compatible-versions :initarg :compatible-versions + :initform nil)) (:documentation "SYSTEM is the base class for top-level components that users may request ASDF to build.")) @@ -262,3 +265,13 @@ return the absolute pathname of a corresponding file under that system's source (defmethod component-build-pathname ((c component)) nil)) +;;;; version-satisfies +(with-upgradability () + (defmethod version-satisfies ((c system) version) + (let ((component-version (nth-value 1 (component-version c)))) + (unless (and version component-version) + (when version + (warn "Requested version ~S but ~S has no version" version c)) + (return-from version-satisfies nil)) + (version-constraint-satisfied-p component-version version + :compatible-versions (system-compatible-versions c))))) diff --git a/uiop/version.lisp b/uiop/version.lisp index 92dc468e..618d3fc4 100644 --- a/uiop/version.lisp +++ b/uiop/version.lisp @@ -365,8 +365,8 @@ segment can consist of at most two identifiers. The first must be \"alpha\", (member (first constraint) '(:and :or)))) (defun compound-version-constraint-satisfied-p (operator version subcs &rest args - &key strip-pre-release-p) - (declare (ignore strip-pre-release-p)) + &key strip-pre-release-p compatible-versions) + (declare (ignore strip-pre-release-p compatible-versions)) (ecase operator (:and (every (lambda (subc) (apply 'version-constraint-satisfied-p version subc args)) @@ -395,8 +395,10 @@ segment can consist of at most two identifiers. The first must be \"alpha\", (apply 'version-constraint-satisfied-p requested compatible-versions (remove-plist-key :compatible-versions args)))))) - (defun version-constraint-satisfied-p (version constraint &rest args &key strip-pre-release-p) - (declare (ignore strip-pre-release-p)) + (defun version-constraint-satisfied-p (version constraint + &rest args + &key strip-pre-release-p compatible-versions) + (declare (ignore strip-pre-release-p compatible-versions)) (let ((version (ensure-version version))) (cond ((simple-version-constraint-p constraint) @@ -404,7 +406,7 @@ segment can consist of at most two identifiers. The first must be \"alpha\", (first constraint) version (ensure-version (second constraint) :class (class-of version)) - args)) + (remove-plist-key :compatible-versions args))) ((compatible-version-constraint-p constraint) (let ((requested (ensure-version (if (listp constraint) (second constraint) constraint) :class (class-of version)))) -- GitLab From e0334b72dbd54073e91b67cfd3e82d0087fd8b0b Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 22:42:44 -0500 Subject: [PATCH 31/49] Add tests for :COMPATIBLE-VERSIONS --- test/test-version.script | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/test/test-version.script b/test/test-version.script index e71fd09b..4b919e77 100644 --- a/test/test-version.script +++ b/test/test-version.script @@ -44,6 +44,11 @@ :pathname #.*test-directory* :version "1.2") +(def-test-system :versioned-system-4 + :pathname #.*test-directory* + :version "2.1" + :compatible-versions (:>= "2.0")) + (def-test-system :versioned-system-file-form :defsystem-depends-on ((:version :test-asdf/2 "2.1")) :pathname #.*test-directory* @@ -61,6 +66,7 @@ (vtest :versioned-system-1 "1.0") (vtest :versioned-system-2 "1.0") (vtest :versioned-system-3 "2.0" nil) +(vtest :versioned-system-4 "2.0") (vtest :versioned-system-file-form "1.0") (vtest :versioned-system-file-line "1.0") ;; version UNmatching @@ -72,4 +78,5 @@ (vtest :versioned-system-3 "1.2") (vtest :versioned-system-3 "1.1") (vtest :versioned-system-3 "1.1.1") - +(vtest :versioned-system-4 "1.2" nil) +(vtest :versioned-system-4 "2.3" nil) -- GitLab From 5dbe662cc99dd974658236f5d80f33de3edd9c82 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 22:48:20 -0500 Subject: [PATCH 32/49] Add more tests for version constraints --- test/test-version.script | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/test/test-version.script b/test/test-version.script index 4b919e77..c038d017 100644 --- a/test/test-version.script +++ b/test/test-version.script @@ -65,8 +65,14 @@ (vtest :versioned-system-1 "1.0") (vtest :versioned-system-2 "1.0") +(vtest :versioned-system-2 '(:and "1.0" (:< "2"))) +(vtest :versioned-system-3 '(:= "1.2")) +(vtest :versioned-system-3 '(:<= "1.2")) +(vtest :versioned-system-3 '(:< "1.3")) +(vtest :versioned-system-3 '(:> "1.1")) (vtest :versioned-system-3 "2.0" nil) (vtest :versioned-system-4 "2.0") +(vtest :versioned-system-4 '(:or "1.0" "2.0")) (vtest :versioned-system-file-form "1.0") (vtest :versioned-system-file-line "1.0") ;; version UNmatching @@ -75,8 +81,10 @@ (vtest :versioned-system-2 "1.1" t) (vtest :versioned-system-2 "1.1.1" nil) (vtest :versioned-system-2 "1.2" nil) +(vtest :versioned-system-2 '(:and "1.2" (:< "2")) nil) (vtest :versioned-system-3 "1.2") (vtest :versioned-system-3 "1.1") (vtest :versioned-system-3 "1.1.1") +(vtest :versioned-system-3 '(:/= "1.2") nil) (vtest :versioned-system-4 "1.2" nil) (vtest :versioned-system-4 "2.3" nil) -- GitLab From 26bb2fb889343824a54efbb2914e507826b24e14 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 23:12:08 -0500 Subject: [PATCH 33/49] Manual touchups --- doc/asdf.texinfo | 59 ++++++++++++++++++++---------------------------- 1 file changed, 25 insertions(+), 34 deletions(-) diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index 94dd0483..43189611 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -1803,9 +1803,10 @@ be forced upon you if you were specifying a string. @anchor{Version class} A version class name will be looked up the same way as a component -type (see above), except that only subclasses of @code{uiop:version} -are allowed. Typically, one will not need to specify a version class -name, unless they want to customize their version specifier. +type (see above), except that only subclasses of +@code{uiop:version-object} are allowed. Typically, one will not need +to specify a version class name, unless they want to customize their +version specifier. @subsection Version specifiers @cindex version specifiers @@ -1813,9 +1814,9 @@ name, unless they want to customize their version specifier. @anchor{Version specifiers} A version specifier is a string that can be parsed to make an object -that is a subclass of @code{uiop:version}. The default version class, -@code{uiop:default-version} accepts strings that are parsed in two -segments. +that is a subclass of @code{uiop:version-object}. The default version +class, @code{uiop:default-version} accepts strings that are parsed in +two segments. The first segment denotes the ``core'' version number. It is required and must consist of any number of non-negative integers, separated by @@ -1825,7 +1826,7 @@ The second segment is optional and contains pre-release information. If present, the pre-release segment must be separated from the first by a @code{#\-} character. This segment consists of a ``category'' (@code{alpha}, @code{beta}, or @code{rc}), optionally -followed by @code{#\.} character and a non-negative integer. +followed by @code{#\.} character and a non-negative integer. Examples of valid specifiers include: @@ -3727,7 +3728,7 @@ extensible so that system implementors may use whichever scheme they want. All version specifiers must parse to an object that is a subclass of -@code{uiop:version}. The default version class is +@code{uiop:version-object}. The default version class is @code{uiop:default-version}. A system implementor can choose a non-default class using the @code{:version-class} argument to @code{defsystem}. @@ -3762,8 +3763,8 @@ Returns non-NIL if @code{version} is a pre-release. @deffn {Generic Function} uiop:version-pre-release-for @var{version} If @code{uiop:version-pre-release-p} is non-NIL, this must return an -instance of @code{uiop:version} that represents the version for which -@code{version} is a pre-release. +instance of @code{uiop:version-object} that represents the version for +which @code{version} is a pre-release. If the returned version is @code{final-version}, @code{(uiop:version-pre-release-p final-version)} must be NIL and @@ -3776,11 +3777,9 @@ If the returned version is @code{final-version}, Returns non-NIL if @code{version-1} is ordered before @code{version-2}. -UIOP provides two default methods, @code{(uiop:version string)} and -@code{(string uiop:version)}. Each parses the string as a version -object (using the equivalent of -@code{(make-instance (class-of version) :version-string string)} and -then calls @code{uiop:version<} again. +UIOP provides default methods that parse strings as +@code{uiop:default-version} using @code{uiop:make-version} and then +call @code{uiop:version<} again. @end deffn @@ -3798,7 +3797,7 @@ Returns the version of @code{component}. Returns two values. For backwards compatibility, the first value is the string representation of the version, or NIL (if no version is specified or it is invalid). The second value is the object that is a subclass of -@code{uiop:version}. +@code{uiop:version-object}. @end deffn @@ -3919,29 +3918,21 @@ break horribly as the code could change drastically before it is fully released. The primary entry point to the version constraint checking logic is -@code{version-satisfies}. +@code{uiop:version-constraint-satisfied-p}. -@deffn {Generic Function} version-satisfies @var{version} @var{version-constraint} +@defun version-constraint-satisfied-p @var{version} @var{version-constraint} &key @var{strip-pre-release-p} @var{compatible-versions} -Does @var{version} satisfy the @var{version-spec}. Returns two values, -the first is a boolean. If the first is NIL, the second value contains -a section of the @code{version-constraint} that is not satisfied. +Returns non-NIL if @var{version} satisfies the @var{version-constraint}. -ASDF provides built-in methods for @var{version} being a @code{component} or @code{string}. -@var{version-constraint} should be a version constraint specified in the version constraint DSL. -If @code{version} is a component, its version is extracted before further processing. +If @var{strip-pre-release-p} is provided and non-NIL, then any +pre-release information will be unconditionally stripped from +@var{version}. If it is provided and NIL, then no pre-release +information is ever stripped from @var{version}. -This function should not need to be specialized. +If @var{compatible-versions} is non-NIL, it must be a version +constraint that is used during checking of compatibility constraints. -In versions of ASDF prior to 3.0.1, including the entire ASDF 1 and -ASDF 2 series, @code{version-satisfies} would also require that the -version and the version-spec have the same major version number (the -first integer in the list); if the major version differed, the version -would be considered as not matching the constraint. But that feature -was not documented, therefore presumably not relied upon, whereas it -was a nuisance to several users. - -@end deffn +@end defun @node Controlling where ASDF searches for systems, Controlling where ASDF saves compiled files, Version specifiers and ASDF, Top @comment node-name, next, previous, up -- GitLab From 52ad0115823f04aef6c907d360a830e2e7743057 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 23:26:07 -0500 Subject: [PATCH 34/49] Remove some internal uses of PARSE-VERSION --- uiop/run-program.lisp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/uiop/run-program.lisp b/uiop/run-program.lisp index ff0f87dc..fb683657 100644 --- a/uiop/run-program.lisp +++ b/uiop/run-program.lisp @@ -424,7 +424,7 @@ or whether it's already taken care of by the implementation's underlying run-pro 'run-program :stream)) #+(or abcl allegro clozure cmucl ecl (and lispworks os-unix) mkcl sbcl scl) (let (#+(or abcl ecl mkcl) - (version (parse-version + (version (make-version #-abcl (lisp-implementation-version) #+abcl @@ -570,8 +570,8 @@ or an indication of failure via the EXIT-CODE of the process" #-(or allegro clisp clozure sbcl) (os-cond ((os-windows-p) t)))) #+(or clasp clisp cormanlisp gcl (and lispworks os-windows) mcl xcl) t ;; A race condition in ECL <= 16.0.0 prevents using ext:run-program - #+ecl #.(if-let (ver (parse-version (lisp-implementation-version))) - (lexicographic<= '< ver '(16 0 0))) + #+ecl #.(if-let (ver (make-version (lisp-implementation-version))) + (version<= ver "16.0.0")) #+(and lispworks os-unix) (%interactivep input output error-output)) '%use-system '%use-launch-program) command keys))) -- GitLab From 76aa095380f153dd7f6c40c5a981489e520a8f16 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 23:29:15 -0500 Subject: [PATCH 35/49] Remove uses of PARSE-VERSION from ASDF tools --- tools/release.lisp | 2 +- tools/version.lisp | 12 +++--------- 2 files changed, 4 insertions(+), 10 deletions(-) diff --git a/tools/release.lisp b/tools/release.lisp index 76d01463..ea901f9b 100644 --- a/tools/release.lisp +++ b/tools/release.lisp @@ -197,7 +197,7 @@ (break) ;; for each function, offer to do it or not (?) (with-asdf-dir () (let ((log (newlogfile "release" "all")) - (releasep (= (length (parse-version new-version)) 3))) + (releasep (not (uiop:version-pre-release-p (make-version new-version))))) (when releasep (let ((debian-version (debian-version-from-file))) (unless (equal new-version (parse-debian-version debian-version)) diff --git a/tools/version.lisp b/tools/version.lisp index 15e295a1..4f59ead1 100644 --- a/tools/version.lisp +++ b/tools/version.lisp @@ -54,18 +54,12 @@ (defparameter *new-version* :default) (defun compute-next-version (v) - (let ((pv (parse-version v 'error))) - (assert (first pv)) - (assert (second pv)) - (unless (third pv) (appendf pv (list 0))) - (unless (fourth pv) (appendf pv (list 0))) - (incf (car (last pv))) - (unparse-version pv))) + (version-string (version-next v))) (defun versions-from-args (&optional v1 v2) (labels ((check (old new) - (parse-version old 'error) - (parse-version new 'error) + (make-version old) + (make-version new) (values old new))) (cond ((and v1 v2) (check v1 v2)) -- GitLab From 78902022a7613c0eaa444d157507a476567bd8a4 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 23:36:39 -0500 Subject: [PATCH 36/49] Fix version in DELIVER-ASD-OP --- bundle.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bundle.lisp b/bundle.lisp index c266edd8..00fc1ab3 100644 --- a/bundle.lisp +++ b/bundle.lisp @@ -481,7 +481,7 @@ which is probably not what you want; you probably need to tweak your output tran (let ((*package* (find-package :asdf-user))) (pprint `(defsystem ,name :class prebuilt-system - :version ,version + :version ,(version-string version) :depends-on ,depends-on :components ((:compiled-file ,(pathname-name fasl))) ,@(when library `(:lib ,(file-namestring library)))) -- GitLab From d067b64ed9e3e883ba7433244ea0681f24b9a7ea Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 23:37:35 -0500 Subject: [PATCH 37/49] white space --- component.lisp | 1 + 1 file changed, 1 insertion(+) diff --git a/component.lisp b/component.lisp index ec67efe9..59b932e2 100644 --- a/component.lisp +++ b/component.lisp @@ -90,6 +90,7 @@ or NIL for top-level components (a.k.a. systems)")) (format s (compatfmt "~@") (duplicate-names-name c)))))) + (with-upgradability () (defclass component () ((name :accessor component-name :initarg :name :type string :documentation -- GitLab From 9c8cf2d6282b98ce3e5d85d2abb233cc71ec5c86 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 23:39:35 -0500 Subject: [PATCH 38/49] Fix a use of COMPONENT-VERSION --- system-registry.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/system-registry.lisp b/system-registry.lisp index 23f10627..71e286fd 100644 --- a/system-registry.lisp +++ b/system-registry.lisp @@ -100,7 +100,7 @@ If VERSION is the default T, and a system was already loaded, then its version w (let ((name (coerce-name system-name))) (when (eql version t) (if-let (system (registered-system name)) - (setf (getf keys :version) (nth-value 1 (component-version system))))) + (setf (getf keys :version) (component-version system)))) (setf (gethash name *preloaded-systems*) keys) (ensure-preloaded-system-registered system-name))) -- GitLab From 7865d865936266ecd0a22155d5bd090864684c37 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 23:41:13 -0500 Subject: [PATCH 39/49] Make CCL happier about some unused variables in methods --- uiop/version.lisp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/uiop/version.lisp b/uiop/version.lisp index 618d3fc4..dcc1fa53 100644 --- a/uiop/version.lisp +++ b/uiop/version.lisp @@ -96,10 +96,12 @@ stating for which version it is a pre-release.") (:method (version1 (version2 null)) "This method doesn't make a lot of sense, but it it here to maintain backward compatibility with the behavior of VERSION< prior to 3.4." + (declare (ignore version1)) nil) (:method ((version1 null) version2) "This method doesn't make a lot of sense, but it it here to maintain backward compatibility with the behavior of VERSION< prior to 3.4." + (declare (ignore version2)) t) (:method ((version1 null) (version2 null)) "This method doesn't make a lot of sense, but it it here to maintain -- GitLab From 53615fdb96c57b0131638df39a8c252e9f48119f Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Sun, 28 Nov 2021 23:51:46 -0500 Subject: [PATCH 40/49] Fix some uses of MAKE-VERSION --- uiop/run-program.lisp | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/uiop/run-program.lisp b/uiop/run-program.lisp index fb683657..efec38a0 100644 --- a/uiop/run-program.lisp +++ b/uiop/run-program.lisp @@ -424,15 +424,16 @@ or whether it's already taken care of by the implementation's underlying run-pro 'run-program :stream)) #+(or abcl allegro clozure cmucl ecl (and lispworks os-unix) mkcl sbcl scl) (let (#+(or abcl ecl mkcl) - (version (make-version - #-abcl - (lisp-implementation-version) - #+abcl - (second (split-string (implementation-identifier) :separator '(#\-)))))) + (version (ignore-errors + (make-version + #-abcl + (lisp-implementation-version) + #+abcl + (second (split-string (implementation-identifier) :separator '(#\-))))))) (nest - #+abcl (unless (lexicographic< '< version '(1 4 0))) - #+ecl (unless (lexicographic<= '< version '(16 0 0))) - #+mkcl (unless (lexicographic<= '< version '(1 1 9))) + #+abcl (unless (version< version "1.4.0")) + #+ecl (unless (version<= version "16.0.0")) + #+mkcl (unless (version<= version "1.1.9")) (return-from %system (wait-process (apply 'launch-program (%normalize-system-command command) keys))))) @@ -570,7 +571,7 @@ or an indication of failure via the EXIT-CODE of the process" #-(or allegro clisp clozure sbcl) (os-cond ((os-windows-p) t)))) #+(or clasp clisp cormanlisp gcl (and lispworks os-windows) mcl xcl) t ;; A race condition in ECL <= 16.0.0 prevents using ext:run-program - #+ecl #.(if-let (ver (make-version (lisp-implementation-version))) + #+ecl #.(if-let (ver (ignore-errors (make-version (lisp-implementation-version)))) (version<= ver "16.0.0")) #+(and lispworks os-unix) (%interactivep input output error-output)) '%use-system '%use-launch-program) -- GitLab From 1e6143d3e97279eeebc9a4153b031d716f5f55b5 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Mon, 29 Nov 2021 08:46:40 -0500 Subject: [PATCH 41/49] Fix use of version in DELIVER-ASD-OP --- bundle.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bundle.lisp b/bundle.lisp index 00fc1ab3..7e0db4eb 100644 --- a/bundle.lisp +++ b/bundle.lisp @@ -481,9 +481,9 @@ which is probably not what you want; you probably need to tweak your output tran (let ((*package* (find-package :asdf-user))) (pprint `(defsystem ,name :class prebuilt-system - :version ,(version-string version) :depends-on ,depends-on :components ((:compiled-file ,(pathname-name fasl))) + ,@(when version `(:version ,(version-string version))) ,@(when library `(:lib ,(file-namestring library)))) s) (terpri s))))) -- GitLab From 2fbd023fb763826e3958561b79baa5a3943e1e68 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Mon, 29 Nov 2021 09:15:31 -0500 Subject: [PATCH 42/49] Mark cmucl upgrades tests as failing --- gitlab-pipelines/standard-pipeline.yml | 31 +++++++++++++------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/gitlab-pipelines/standard-pipeline.yml b/gitlab-pipelines/standard-pipeline.yml index 3e3aadb7..8352f2bc 100644 --- a/gitlab-pipelines/standard-pipeline.yml +++ b/gitlab-pipelines/standard-pipeline.yml @@ -111,22 +111,22 @@ Upgrade test: extends: .Upgrade test template parallel: matrix: - - l: [abcl, allegro, ccl, clasp, clisp, cmucl, ecl, sbcl] + - l: [abcl, allegro, ccl, clasp, clisp, ecl, sbcl] IMAGE_TAG: latest - l: allegro IMAGE_TAG: latest variant: modern -# 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 +Upgrade test known failure: + extends: .Upgrade test template + parallel: + matrix: + # CMUCL fails due to CLOS bugs. 3.4 adds a new slot to SYSTEM, which + # causes "Error in function KERNEL:CLASS-TYPEP: Class is currently + # invalid: #" + - l: [cmucl] + IMAGE_TAG: latest + allow_failure: true .REQUIRE upgrade test template: extends: .Upgrade test template @@ -141,21 +141,22 @@ REQUIRE upgrade test: ASDF_UPGRADE_TEST_TAGS: REQUIRE parallel: matrix: - - l: [abcl, allegro, ccl, clisp, cmucl, ecl, sbcl] + - l: [abcl, allegro, ccl, clisp, ecl, sbcl] IMAGE_TAG: latest - l: allegro IMAGE_TAG: latest variant: modern -# 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: + # CMUCL fails due to CLOS bugs. 3.4 adds a new slot to SYSTEM, which + # causes "Error in function KERNEL:CLASS-TYPEP: Class is currently + # invalid: #" + - l: [cmucl] - l: [clasp] IMAGE_TAG: latest allow_failure: true -- GitLab From 896c98f05b42a683c2cec2ff9dae2bf10b64315b Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Mon, 29 Nov 2021 10:46:04 -0500 Subject: [PATCH 43/49] Mark ABCL upgrade tests as failing --- gitlab-pipelines/standard-pipeline.yml | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/gitlab-pipelines/standard-pipeline.yml b/gitlab-pipelines/standard-pipeline.yml index 8352f2bc..c5f1f9db 100644 --- a/gitlab-pipelines/standard-pipeline.yml +++ b/gitlab-pipelines/standard-pipeline.yml @@ -111,7 +111,7 @@ Upgrade test: extends: .Upgrade test template parallel: matrix: - - l: [abcl, allegro, ccl, clasp, clisp, ecl, sbcl] + - l: [allegro, ccl, clasp, clisp, ecl, sbcl] IMAGE_TAG: latest - l: allegro IMAGE_TAG: latest @@ -124,7 +124,10 @@ Upgrade test known failure: # CMUCL fails due to CLOS bugs. 3.4 adds a new slot to SYSTEM, which # causes "Error in function KERNEL:CLASS-TYPEP: Class is currently # invalid: #" - - l: [cmucl] + # + # ABCL fails due to compiler macros being called for generic functions + # locally declared NOTINLINE. See https://abcl.org/trac/ticket/487 + - l: [cmucl, abcl] IMAGE_TAG: latest allow_failure: true @@ -141,7 +144,7 @@ REQUIRE upgrade test: ASDF_UPGRADE_TEST_TAGS: REQUIRE parallel: matrix: - - l: [abcl, allegro, ccl, clisp, ecl, sbcl] + - l: [allegro, ccl, clisp, ecl, sbcl] IMAGE_TAG: latest - l: allegro IMAGE_TAG: latest @@ -157,6 +160,9 @@ REQUIRE upgrade test known failure: # causes "Error in function KERNEL:CLASS-TYPEP: Class is currently # invalid: #" - l: [cmucl] + # ABCL fails due to compiler macros being called for generic functions + # locally declared NOTINLINE. See https://abcl.org/trac/ticket/487 + - l: [abcl] - l: [clasp] IMAGE_TAG: latest allow_failure: true -- GitLab From b7b85bc417d5b8b4f3ed6e07ba9764af52ea19e5 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Mon, 29 Nov 2021 15:36:51 -0500 Subject: [PATCH 44/49] Allow DEFAULT-VERSION to contain two integers This makes guidance on how to version local edits more clear. --- doc/asdf.texinfo | 3 ++- uiop/version.lisp | 14 +++++--------- upgrade.lisp | 6 +++--- 3 files changed, 10 insertions(+), 13 deletions(-) diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index 43189611..1f64f412 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -1826,7 +1826,8 @@ The second segment is optional and contains pre-release information. If present, the pre-release segment must be separated from the first by a @code{#\-} character. This segment consists of a ``category'' (@code{alpha}, @code{beta}, or @code{rc}), optionally -followed by @code{#\.} character and a non-negative integer. +followed by one or two non-negative integers, separated from the +catagory and easch other by a @code{#\.} character. Examples of valid specifiers include: diff --git a/uiop/version.lisp b/uiop/version.lisp index dcc1fa53..22b8f9aa 100644 --- a/uiop/version.lisp +++ b/uiop/version.lisp @@ -314,8 +314,8 @@ If VERSION-STRING is otherwise invalid, a VERSION-STRING-INVALID-ERROR is signal (:documentation "A version specifier that parses and orders identically to SEMANTIC-VERSION. However, no build metadata is allowed and the pre-release -segment can consist of at most two identifiers. The first must be \"alpha\", -\"beta\", or \"rc\". The second must be an integer.")) +segment can consist of at most three identifiers. The first must be \"alpha\", +\"beta\", or \"rc\". The second and third (if they exist) must be integers.")) (defmethod initialize-instance :after ((version default-version) &key version-string) (with-slots (pre-release-segment build-metadata-segment) version @@ -325,16 +325,12 @@ segment can consist of at most two identifiers. The first must be \"alpha\", (unless (null build-metadata-segment) (invalid "The build metadata segment must not exist.")) (unless (or (null pre-release-segment) - (and (= 1 (length pre-release-segment)) - (or (equal "alpha" (first pre-release-segment)) - (equal "beta" (first pre-release-segment)) - (equal "rc" (first pre-release-segment)))) - (and (= 2 (length pre-release-segment)) + (and (<= (length pre-release-segment) 3) (or (equal "alpha" (first pre-release-segment)) (equal "beta" (first pre-release-segment)) (equal "rc" (first pre-release-segment))) - (integerp (second pre-release-segment)))) - (invalid "The pre-release segment must be absent or consist of \"alpha\", \"beta\", or \"rc\", optionally followed by an integer.")))))) + (every #'integerp (rest pre-release-segment)))) + (invalid "The pre-release segment must be absent or consist of \"alpha\", \"beta\", or \"rc\", optionally followed by up to two integers.")))))) (with-upgradability () (defun simple-version-constraint-p (constraint) diff --git a/upgrade.lisp b/upgrade.lisp index 47931270..aacfa909 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -94,9 +94,9 @@ previously-loaded version of ASDF." ;; Relying on its automation, the version is now redundantly present on top of asdf.lisp. ;; "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 branch, on top 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 + ;; "3.4.6-alpha.1" would be a development version in the official branch, on top of 3.4.5. + ;; "3.4.5.8" would be your eighth local modification of official release 3.4.5 + ;; "3.4.6-alpha.1.8" would be your eighth local modification of development version 3.4.6-alpha.1 (asdf-version "3.4.0-alpha.1") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) -- GitLab From b04f4ee0e5b74052340ae78d79a3c321ee7f38f3 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Wed, 5 Jan 2022 12:37:36 -0500 Subject: [PATCH 45/49] Handle internal use of deprecated functions using NOTINLINE --- uiop/backward-driver.lisp | 5 ++-- uiop/version.lisp | 57 +++++++++++++++++---------------------- 2 files changed, 28 insertions(+), 34 deletions(-) diff --git a/uiop/backward-driver.lisp b/uiop/backward-driver.lisp index bf7e8a3f..0e946299 100644 --- a/uiop/backward-driver.lisp +++ b/uiop/backward-driver.lisp @@ -63,7 +63,8 @@ If major versions differ, it's not compatible. If they are equal, then any later version is compatible, with later being determined by a lexicographical comparison of minor numbers. DEPRECATED." - (let ((x (uiop/version::%parse-version provided-version nil)) - (y (uiop/version::%parse-version required-version nil))) + (declare (notinline parse-version)) + (let ((x (parse-version provided-version nil)) + (y (parse-version required-version nil))) (and x y (= (car x) (car y)) (lexicographic<= '< (cdr y) (cdr x))))))) diff --git a/uiop/version.lisp b/uiop/version.lisp index 22b8f9aa..7a5cc9ab 100644 --- a/uiop/version.lisp +++ b/uiop/version.lisp @@ -536,41 +536,12 @@ from instrumentation by enclosing it in a PROGN." ;; All of these were deprecated in 3.4 (with-upgradability () - ;; These implement the actual logic of the deprecated functions. Doing it - ;; this way ensures that we don't get style warnings when loading UIOP - ;; itself. - (defun %unparse-version (version-list) - (format nil "~{~D~^.~}" version-list)) - (defun %parse-version (version-string &optional on-error) - (block nil - (unless (stringp version-string) - (call-function on-error "~S: ~S is not a string" 'parse-version version-string) - (return)) - (unless (loop :for prev = nil :then c :for c :across version-string - :always (or (digit-char-p c) - (and (eql c #\.) prev (not (eql prev #\.)))) - :finally (return (and c (digit-char-p c)))) - (call-function on-error "~S: ~S doesn't follow asdf version numbering convention" - 'parse-version version-string) - (return)) - (let* ((version-list - (mapcar #'parse-integer (split-string version-string :separator "."))) - (normalized-version (%unparse-version version-list))) - (unless (equal version-string normalized-version) - (call-function on-error "~S: ~S contains leading zeros" 'parse-version version-string)) - version-list))) - (defun %next-version (version) - (when version - (let ((version-list (%parse-version version))) - (incf (car (last version-list))) - (%unparse-version version-list)))) - (with-deprecation ((version-deprecation *uiop-version* :style-warning "3.4" :delete "4.0")) (defun unparse-version (version-list) "DEPRECATED. Use VERSION-STRING instead. From a parsed version (a list of natural numbers), compute the version string" - (%unparse-version version-list)) + (format nil "~{~D~^.~}" version-list)) (defun parse-version (version-string &optional on-error) "DEPRECATED. Use MAKE-VERSION instead. @@ -583,11 +554,33 @@ When invalid, ON-ERROR is called as per CALL-FUNCTION before to return NIL, with format arguments explaining why the version is invalid. ON-ERROR is also called if the version is not canonical in that it doesn't print back to itself, but the list is returned anyway." - (%parse-version version-string on-error)) + (declare (notinline unparse-version)) + (block nil + (unless (stringp version-string) + (call-function on-error "~S: ~S is not a string" 'parse-version version-string) + (return)) + (unless (loop :for prev = nil :then c :for c :across version-string + :always (or (digit-char-p c) + (and (eql c #\.) prev (not (eql prev #\.)))) + :finally (return (and c (digit-char-p c)))) + (call-function on-error "~S: ~S doesn't follow asdf version numbering convention" + 'parse-version version-string) + (return)) + (let* ((version-list + (mapcar #'parse-integer (split-string version-string :separator "."))) + (normalized-version (unparse-version version-list))) + (unless (equal version-string normalized-version) + (call-function on-error "~S: ~S contains leading zeros" 'parse-version version-string)) + version-list))) (defun next-version (version) "DEPRECATED. Use VERSION-NEXT instead. When VERSION is not nil, it is a string, then parse it as a version, compute the next version and return it as a string." - (%next-version version)))) + (declare (notinline parse-version unparse-version next-version)) + (when version + (let ((version-list (parse-version version))) + (incf (car (last version-list))) + (unparse-version version-list))) + (next-version version)))) -- GitLab From 53b30f0bca3873521ae9612bb2a1ae272fe6a77f Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Wed, 5 Jan 2022 21:13:40 -0500 Subject: [PATCH 46/49] Fix the :VERSION field in uiop.asd --- uiop/uiop.asd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/uiop/uiop.asd b/uiop/uiop.asd index 72fffb0d..f6da0797 100644 --- a/uiop/uiop.asd +++ b/uiop/uiop.asd @@ -49,4 +49,4 @@ you already have a matching UIOP loaded." :around-compile call-without-redefinition-warnings . #-asdf3.1 () #+asdf3.1 (:class package-system - :version (:read-file-form "version.lisp" :at (2 2 2))))) + :version (:read-file-form "version.lisp" :at (2 3 2))))) -- GitLab From 015f1ea3488a0b5395e9bd48e613de80f6f04c10 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Wed, 5 Jan 2022 21:15:03 -0500 Subject: [PATCH 47/49] Add :ASDF3.4 to *FEATURES* --- footer.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/footer.lisp b/footer.lisp index dbb96f8c..bc36c003 100644 --- a/footer.lisp +++ b/footer.lisp @@ -83,7 +83,7 @@ (setf excl:*warn-on-nested-reader-conditionals* uiop/common-lisp::*acl-warn-save*)) ;; Advertise the features we provide. - (dolist (f '(:asdf :asdf2 :asdf3 :asdf3.1 :asdf3.2 :asdf3.3)) (pushnew f *features*)) + (dolist (f '(:asdf :asdf2 :asdf3 :asdf3.1 :asdf3.2 :asdf3.3 :asdf3.4)) (pushnew f *features*)) ;; Provide both lowercase and uppercase, to satisfy more people, especially LispWorks users. (provide "asdf") (provide "ASDF") -- GitLab From aa4c42a3e111034f3143efe091eb607b571fcd53 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Wed, 5 Jan 2022 21:30:00 -0500 Subject: [PATCH 48/49] Prevent spurious bad version string warnings when upgrading from <=3.3 We still ended up with the correct version number anyways, but just killing the warnings completely makes it less likely the end user will thing something's gone wrong. --- asdf.asd | 9 ++++++--- bin/bump-version | 3 ++- uiop/uiop.asd | 2 +- 3 files changed, 9 insertions(+), 5 deletions(-) diff --git a/asdf.asd b/asdf.asd index a286ab7c..65233094 100644 --- a/asdf.asd +++ b/asdf.asd @@ -23,7 +23,7 @@ ;; and compulsory to sort them in defsystem-depends-on order. #+asdf3 (defsystem "asdf/prelude" - :version (:read-file-form "full-version.lisp-expr") + :version #+asdf3.4 (:read-file-form "full-version.lisp-expr") #-asdf3.4 (:read-file-form "version.lisp-expr") :around-compile call-without-redefinition-warnings ;; we need be the same as uiop :encoding :utf-8 :components ((:file "header"))) @@ -51,7 +51,7 @@ :bug-tracker "https://launchpad.net/asdf/" :mailto "asdf-devel@common-lisp.net" :source-control (:git "git://common-lisp.net/projects/asdf/asdf.git") - :version (:read-file-form "full-version.lisp-expr") + :version #+asdf3.4 (:read-file-form "full-version.lisp-expr") #-asdf3.4 (:read-file-form "version.lisp-expr") :build-operation monolithic-concatenate-source-op :build-pathname "build/asdf" ;; our target :around-compile call-without-redefinition-warnings ;; we need be the same as uiop @@ -93,7 +93,10 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "3.4.0-alpha.1" ;; to be automatically updated by make bump-version + ;; Having two :VERSION arguments makes the bump-version script a bit easier + ;; to write for a non-Perl expert. + #+asdf3.4 :version #+asdf3.4 "3.4.0-alpha.1" ;; to be automatically updated by make bump-version + #-asdf3.4 :version #-asdf3.4 "3.4.0" ;; to be automatically updated by make bump-version :depends-on () :components ((:module "build" :components ((:file "asdf")))) . #-asdf3 () #+asdf3 diff --git a/bin/bump-version b/bin/bump-version index 63d29f2b..df030ab0 100755 --- a/bin/bump-version +++ b/bin/bump-version @@ -26,7 +26,8 @@ our @transform_ref = [ "version.lisp-expr", "\"", "\"", 1], [ "full-version.lisp-expr", "\"", "\"", 0], [ "uiop/version.lisp", "(defparameter *uiop-version* \"", "\")", 0 ], - [ "asdf.asd", " :version \"", "\" ;; to be automatically updated by make bump-version", 0 ], + [ "asdf.asd", " #+asdf3.4 :version #+asdf3.4 \"", "\" ;; to be automatically updated by make bump-version", 0 ], + [ "asdf.asd", " #-asdf3.4 :version #-asdf3.4 \"", "\" ;; to be automatically updated by make bump-version", 1 ], [ "header.lisp", "This is ASDF ", ": Another System Definition Facility.", 0 ], [ "upgrade.lisp", "(asdf-version \"", "\")", 0 ], [ "doc/asdf.texinfo", "Manual for Version ", "", 0 ], ); diff --git a/uiop/uiop.asd b/uiop/uiop.asd index f6da0797..62fdd6cb 100644 --- a/uiop/uiop.asd +++ b/uiop/uiop.asd @@ -49,4 +49,4 @@ you already have a matching UIOP loaded." :around-compile call-without-redefinition-warnings . #-asdf3.1 () #+asdf3.1 (:class package-system - :version (:read-file-form "version.lisp" :at (2 3 2))))) + :version #-asdf3.4 (:read-file-form "version.lisp" :at (2 2 2)) #+asdf3.4 (:read-file-form "version.lisp" :at (2 3 2))))) -- GitLab From 595fc89787ac4cc63619cf3066b98a1c3db3db91 Mon Sep 17 00:00:00 2001 From: Eric Timmons Date: Thu, 27 Jan 2022 12:00:47 -0500 Subject: [PATCH 49/49] Make COMPONENT-VERSION backwards compatible COMPONENT-VERSION has explicitly said in its documentation (for several years now) that the returned version is NIL *or* a string of dot-separated natural numbers. In order to maintain backward compatbility, keep the same semantics by only returning the version if it fits those criteria. To increase the usefulness of this function, state that if the version is a pre-release (in which case it almost certainly will *not* meet the criteria), it returns the result of VERSION-PRE-RELEASE-FOR. Add function COMPONENT-VERSION* which returns a VERSION-OBJECT directly. This may be modified if, after checking QL, we determine that no one is counting on COMPONENT-VERSION having dot-separated natural numbers. --- bundle.lisp | 2 +- component.lisp | 42 +++++++++++++++++++++++----------------- doc/asdf.texinfo | 20 ++++++++++++++----- doc/exported-functions | 3 +++ footer.lisp | 6 +++--- interface.lisp | 2 ++ system-registry.lisp | 2 +- system.lisp | 29 ++++++++++++++++++--------- test/script-support.lisp | 8 ++++---- test/test-version.script | 10 +++++++++- 10 files changed, 82 insertions(+), 42 deletions(-) diff --git a/bundle.lisp b/bundle.lisp index 7e0db4eb..430dceac 100644 --- a/bundle.lisp +++ b/bundle.lisp @@ -444,7 +444,7 @@ or of opaque libraries shipped along the source code.")) (library (second inputs)) (asd (output-file o s)) (name (if (and fasl asd) (pathname-name asd) (return-from perform))) - (version (nth-value 1 (component-version s))) + (version (component-version* s)) (dependencies (if (operation-monolithic-p o) ;; We want only dependencies, and we use basic-load-op rather than load-op so that diff --git a/component.lisp b/component.lisp index 59b932e2..80870d76 100644 --- a/component.lisp +++ b/component.lisp @@ -18,7 +18,7 @@ #:component-in-order-to #:component-sideway-dependencies #:component-if-feature #:around-compile-hook #:component-description #:component-long-description - #:component-version #:version-satisfies + #:component-version #:component-version* #:version-satisfies #:component-inline-methods ;; backward-compatibility only. DO NOT USE! #:component-operation-times ;; For internal use only. ;; portable ASDF encoding and implementation-specific external-format @@ -65,9 +65,15 @@ Use asdf-encodings to support more encodings.")) (:documentation "Check whether a COMPONENT satisfies the constraint of being at least as recent as the specified VERSION, which must be a string of dot-separated natural numbers, or NIL.")) (defgeneric component-version (component) - (:documentation "Return the version of a COMPONENT in two VALUES. The first -value is a string that specifies the version, or NIL. The second value is the -VERSION-OBJECT instance that is suitable for use with UIOP:VERSION<, or NIL.")) + (:documentation "Return the version of a COMPONENT, which must be a string +of dot-separated natural numbers, or NIL. If the component is a pre-release, +returns the version which it is a pre-release for. + +This function is kept for backward compatibility. New code should prefer to use +COMPONENT-VERSION*.")) + (defgeneric component-version* (component) + (:documentation "Return the version of a COMPONENT. The returned version is +version object suitable for use with VERSION< and friends (or NIL).")) (defgeneric (setf component-version) (new-version component) (:documentation "Updates the version of a COMPONENT.")) (defgeneric component-version-class (component) @@ -166,21 +172,21 @@ The return value is a list of component NAMES; a list of strings." component)) (defmethod component-version ((component component)) - "The VERSION slot of COMPONENT may be NIL, unbound, a string, or a -VERSION-OBJECT. If it's a string, update it to be a VERSION-OBJECT and return -it. If it's a VERSION-OBJECT object, return it. Else, return NIL." + ;; The VERSION slot of COMPONENT may be NIL, unbound, or a + ;; VERSION-OBJECT. It should not be a string (due to the + ;; *post-upgrade-cleanup-hook*). (if-let (raw-version (and (slot-boundp component 'version) (slot-value component 'version))) - (typecase raw-version - (string - ;; If we're upgrading ASDF and some systems have already been loaded, - ;; they likely have the old representation of the version (plain - ;; string) stored. - (let ((new-version (make-version raw-version))) - (setf (slot-value component 'version) new-version) - (values (version-string new-version) new-version))) - (version-object - (values (version-string raw-version) raw-version))))) + (progn + ;; This ensures that all pre-release info is stripped. + (when (version-pre-release-p raw-version) + (setf raw-version (version-pre-release-for raw-version))) + ;; Ensure that it parses as a series of dot-separated integers. + (ignore-errors (version-string (make-version (version-string raw-version))))))) + (defmethod component-version* ((component component)) + (if-let (raw-version (and (slot-boundp component 'version) + (slot-value component 'version))) + raw-version)) (defmethod (setf component-version) ((value string) (component component)) "Set the VERSION slot of component." @@ -345,7 +351,7 @@ this compilation, or check its results, etc.")) (defmethod version-satisfies :around ((c t) (version null)) t) (defmethod version-satisfies ((c component) version) - (let ((component-version (component-version c))) + (let ((component-version (component-version* c))) (unless (and version component-version) (when version (warn "Requested version ~S but ~S has no version" version c)) diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo index 1f64f412..91acd617 100644 --- a/doc/asdf.texinfo +++ b/doc/asdf.texinfo @@ -3793,12 +3793,22 @@ the @code{:version-string} initarg. @end deffn @deffn {Generic Function} asdf:component-version @var{component} -Returns the version of @code{component}. Returns two values. +Returns the version of @code{component}. -For backwards compatibility, the first value is the string -representation of the version, or NIL (if no version is specified or -it is invalid). The second value is the object that is a subclass of -@code{uiop:version-object}. +This function is kept for backward compatibility. New code should prefer +@code{component-version*}. + +The version is a string of dot-separated natural numbers, or NIL. If the +component is a pre-release, returns the version which it is a +pre-release for. + +@end deffn + +@deffn {Generic Function} asdf:component-version* @var{component} +Returns the version of @code{component}. + +The returned version is version object suitable for use with +@code{uiop:version<} and friends (or NIL). @end deffn diff --git a/doc/exported-functions b/doc/exported-functions index 2013d3d8..84f10fca 100644 --- a/doc/exported-functions +++ b/doc/exported-functions @@ -28,6 +28,7 @@ COMPONENT-RELATIVE-PATHNAME COMPONENT-SIDEWAY-DEPENDENCIES COMPONENT-SYSTEM COMPONENT-VERSION +COMPONENT-VERSION* COMPUTE-SOURCE-REGISTRY DEFSYSTEM DISABLE-DEFERRED-WARNINGS-CHECK @@ -108,6 +109,8 @@ SYSTEM-SOURCE-DIRECTORY SYSTEM-SOURCE-FILE SYSTEM-SOURCE-REGISTRY SYSTEM-SOURCE-REGISTRY-DIRECTORY +SYSTEM-VERSION +SYSTEM-VERSION* SYSTEM-WEAKLY-DEPENDS-ON TEST-SYSTEM TRAVERSE diff --git a/footer.lisp b/footer.lisp index bc36c003..714a7953 100644 --- a/footer.lisp +++ b/footer.lisp @@ -30,12 +30,12 @@ ;;;; data from the file system that we want to preserve instead of blasting ;;;; away and replacing with a blank preloaded system. (with-upgradability () - (unless (equal (system-version (registered-system "asdf")) (asdf-version)) + (unless (version= (system-version* (registered-system "asdf")) (asdf-version)) (clear-system "asdf")) ;; 3.1.2 is the last version where asdf-package-system was a separate system. - (when (version< "3.1.2" (system-version (registered-system "asdf-package-system"))) + (when (version< "3.1.2" (system-version* (registered-system "asdf-package-system"))) (clear-system "asdf-package-system")) - (unless (equal (system-version (registered-system "uiop")) *uiop-version*) + (unless (version= (system-version* (registered-system "uiop")) *uiop-version*) (clear-system "uiop"))) ;;;; Hook ASDF into the implementation's REQUIRE and other entry points. diff --git a/interface.lisp b/interface.lisp index f2d322b1..dbe59803 100644 --- a/interface.lisp +++ b/interface.lisp @@ -68,6 +68,7 @@ #:component-relative-pathname #:component-name #:component-version + #:component-version* #:component-parent #:component-system #:component-encoding @@ -79,6 +80,7 @@ #:system-license #:system-licence #:system-version + #:system-version* #:system-source-file #:system-source-directory #:system-relative-pathname diff --git a/system-registry.lisp b/system-registry.lisp index 71e286fd..bfc95d02 100644 --- a/system-registry.lisp +++ b/system-registry.lisp @@ -100,7 +100,7 @@ If VERSION is the default T, and a system was already loaded, then its version w (let ((name (coerce-name system-name))) (when (eql version t) (if-let (system (registered-system name)) - (setf (getf keys :version) (component-version system)))) + (setf (getf keys :version) (version-string (component-version* system))))) (setf (gethash name *preloaded-systems*) keys) (ensure-preloaded-system-registered system-name))) diff --git a/system.lisp b/system.lisp index e7cda964..0659a031 100644 --- a/system.lisp +++ b/system.lisp @@ -9,7 +9,7 @@ #:system-source-file #:system-source-directory #:system-relative-pathname #:system-description #:system-long-description #:system-author #:system-maintainer #:system-licence #:system-license - #:system-version #:system-compatible-versions + #:system-version #:system-version* #:system-compatible-versions #:definition-dependency-list #:definition-dependency-set #:system-defsystem-depends-on #:system-depends-on #:system-weakly-depends-on #:component-build-pathname #:build-pathname @@ -202,14 +202,25 @@ the primary one." (defun system-license (system) (system-virtual-slot-value system 'licence)) ;; ASDF4: Move this back into *system-virtual-slots*. We can't return the - ;; slot directly as we want to mimic the result of COMPONENT-VERSION which - ;; now returns two VALUES. + ;; slot directly as we want to mimic the result of COMPONENT-VERSION. (defun system-version (system) - (let ((direct-version (multiple-value-list (component-version system)))) - (if (first direct-version) - (values-list direct-version) - (unless (primary-system-p system) - (component-version (find-system (primary-system-name system)))))))) + "Return the version of SYSTEM, which must be a string of dot-separated +natural numbers, or NIL. If the system is a pre-release, returns the version +which it is a pre-release for. + +This function is kept for backward compatibility. New code should prefer to use +SYSTEM-VERSION*." + (if-let (direct-version (component-version system)) + direct-version + (unless (primary-system-p system) + (component-version (find-system (primary-system-name system)))))) + (defun system-version* (system) + "Return the version of SYSTEM. The returned version is version object +suitable for use with VERSION< and friends (or NIL)." + (if-let (direct-version (component-version* system)) + direct-version + (unless (primary-system-p system) + (component-version* (find-system (primary-system-name system))))))) ;;;; Pathnames @@ -268,7 +279,7 @@ return the absolute pathname of a corresponding file under that system's source ;;;; version-satisfies (with-upgradability () (defmethod version-satisfies ((c system) version) - (let ((component-version (nth-value 1 (component-version c)))) + (let ((component-version (component-version* c))) (unless (and version component-version) (when version (warn "Requested version ~S but ~S has no version" version c)) diff --git a/test/script-support.lisp b/test/script-support.lisp index 2588573a..abc40177 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -761,10 +761,10 @@ is bound, write a message and exit on an error. If (format t "Now loading new asdf via method ~A~%" new-method) (acall (list new-method :asdf-test)) (format t "Testing it~%") - (format t "UIOP: ~S ~S~%" (asymval :*uiop-version*) (acall :system-version (acall :find-system :uiop))) - (format t "ASDF: ~S ~S~%" (get-asdf-version) (acall :system-version (acall :find-system :asdf))) - (assert (equal (asymval :*uiop-version*) (acall :system-version (acall :find-system :uiop)))) - (assert (equal (get-asdf-version) (acall :system-version (acall :find-system :asdf)))) + (format t "UIOP: ~S ~S~%" (asymval :*uiop-version*) (acall :version-string (acall :system-version* (acall :find-system :uiop)))) + (format t "ASDF: ~S ~S~%" (get-asdf-version) (acall :version-string (acall :system-version* (acall :find-system :asdf)))) + (assert (equal (asymval :*uiop-version*) (acall :version-string (acall :system-version* (acall :find-system :uiop))))) + (assert (equal (get-asdf-version) (acall :version-string (acall :system-version* (acall :find-system :asdf))))) (register-directory *test-directory*) (load-test-system :test-asdf/upgrade) (assert (symbol-value '*properly-upgraded*)))) diff --git a/test/test-version.script b/test/test-version.script index c038d017..513709dd 100644 --- a/test/test-version.script +++ b/test/test-version.script @@ -26,7 +26,15 @@ (defparameter *asdf* (find-system :asdf)) (assert-equal nil (system-source-directory *asdf*)) (DBG "Check that the fallback system bears the current asdf version") -(assert-equal (asdf-version) (component-version *asdf*)) +;; Ensure that COMPONENT-VERSION returns only the non-pre-release version string. +(assert-equal (version-string + (let ((version (make-version (asdf-version)))) + (if (version-pre-release-p version) + (version-pre-release-for version) + version))) + (component-version *asdf*)) +;; Ensure pre-release info (if any) isn't lost. +(assert-equal (asdf-version) (version-string (component-version* *asdf*))) (def-test-system :unversioned-system :pathname #.*test-directory*) -- GitLab