amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

utils: Add 'version-unique-prefix'.

Browse source 
* guix/utils.scm (version-unique-prefix): New procedure.
* tests/utils.scm ("version-unique-prefix"): New test.
This commit is contained in:
Ludovic Courtès 2021-01-10 11:53:43 +01:00
parent b41e21488f
commit 579506e272
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 41 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

35
guix/utils.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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 © 2013, 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net> ;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net>
@ -88,6 +88,7 @@
version-major+minor+point version-major+minor+point
version-major+minor version-major+minor
version-major version-major
version-unique-prefix
guile-version>? guile-version>?
version-prefix? version-prefix?
string-replace-substring string-replace-substring
@ -589,6 +590,38 @@ minor version numbers from version-string."
"Return the major version number as string from the version-string." "Return the major version number as string from the version-string."
(version-prefix version-string 1)) (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) (define (version>? a b)
"Return #t when A denotes a version strictly newer than B." "Return #t when A denotes a version strictly newer than B."
(eq? '> (version-compare a b))) (eq? '> (version-compare a b)))

8
tests/utils.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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 © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;; ;;;
@ -78,6 +78,12 @@
(not (version-prefix? "4.1" "4.16.2")) (not (version-prefix? "4.1" "4.16.2"))
(not (version-prefix? "4.1" "4")))) (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*" (test-equal "string-tokenize*"
'(("foo") '(("foo")
("foo" "bar" "baz") ("foo" "bar" "baz")