Skip to content
Snippets Groups Projects
Unverified Commit 579506e2 authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

utils: Add 'version-unique-prefix'.

* guix/utils.scm (version-unique-prefix): New procedure.
* tests/utils.scm ("version-unique-prefix"): New test.
parent b41e2148
No related branches found
No related tags found
No related merge requests found
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net>
......@@ -88,6 +88,7 @@ (define-module (guix utils)
version-major+minor+point
version-major+minor
version-major
version-unique-prefix
guile-version>?
version-prefix?
string-replace-substring
......@@ -589,6 +590,38 @@ (define (version-major version-string)
"Return the major version number as string from the version-string."
(version-prefix version-string 1))
(define (version-unique-prefix version versions)
"Return the shortest version prefix to unambiguously identify VERSION among
VERSIONS. For example:
(version-unique-prefix \"2.0\" '(\"3.0\" \"2.0\"))
=> \"2\"
(version-unique-prefix \"2.2\" '(\"3.0.5\" \"2.0.9\" \"2.2.7\"))
=> \"2.2\"
(version-unique-prefix \"27.1\" '(\"27.1\"))
=> \"\"
"
(define not-dot
(char-set-complement (char-set #\.)))
(define other-versions
(delete version versions))
(let loop ((prefix '())
(components (string-tokenize version not-dot)))
(define prefix-str
(string-join prefix "."))
(if (any (cut string-prefix? prefix-str <>) other-versions)
(match components
((head . tail)
(loop `(,@prefix ,head) tail))
(()
version))
prefix-str)))
(define (version>? a b)
"Return #t when A denotes a version strictly newer than B."
(eq? '> (version-compare a b)))
......
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;;
......@@ -78,6 +78,12 @@ (define temp-file
(not (version-prefix? "4.1" "4.16.2"))
(not (version-prefix? "4.1" "4"))))
(test-equal "version-unique-prefix"
'("2" "2.2" "")
(list (version-unique-prefix "2.0" '("3.0" "2.0"))
(version-unique-prefix "2.2" '("3.0.5" "2.0.9" "2.2.7"))
(version-unique-prefix "27.1" '("27.1"))))
(test-equal "string-tokenize*"
'(("foo")
("foo" "bar" "baz")
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment