utils: Add 'version-prefix?'.
* guix/utils.scm (version-prefix?): New procedure. * tests/utils.scm ("version-prefix?"): New test.
This commit is contained in:
parent
e18e7cb9f4
commit
437f62f02a
|
@ -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 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 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>
|
||||||
|
@ -84,6 +84,7 @@
|
||||||
version-major+minor
|
version-major+minor
|
||||||
version-major
|
version-major
|
||||||
guile-version>?
|
guile-version>?
|
||||||
|
version-prefix?
|
||||||
string-replace-substring
|
string-replace-substring
|
||||||
arguments-from-environment-variable
|
arguments-from-environment-variable
|
||||||
file-extension
|
file-extension
|
||||||
|
@ -521,6 +522,27 @@ minor version numbers from version-string."
|
||||||
(micro-version))
|
(micro-version))
|
||||||
str))
|
str))
|
||||||
|
|
||||||
|
(define version-prefix?
|
||||||
|
(let ((not-dot (char-set-complement (char-set #\.))))
|
||||||
|
(lambda (v1 v2)
|
||||||
|
"Return true if V1 is a version prefix of V2:
|
||||||
|
|
||||||
|
(version-prefix? \"4.1\" \"4.16.2\") => #f
|
||||||
|
(version-prefix? \"4.1\" \"4.1.2\") => #t
|
||||||
|
"
|
||||||
|
(define (list-prefix? lst1 lst2)
|
||||||
|
(match lst1
|
||||||
|
(() #t)
|
||||||
|
((head1 tail1 ...)
|
||||||
|
(match lst2
|
||||||
|
(() #f)
|
||||||
|
((head2 tail2 ...)
|
||||||
|
(and (equal? head1 head2)
|
||||||
|
(list-prefix? tail1 tail2)))))))
|
||||||
|
|
||||||
|
(list-prefix? (string-tokenize v1 not-dot)
|
||||||
|
(string-tokenize v2 not-dot)))))
|
||||||
|
|
||||||
(define (file-extension file)
|
(define (file-extension file)
|
||||||
"Return the extension of FILE or #f if there is none."
|
"Return the extension of FILE or #f if there is none."
|
||||||
(let ((dot (string-rindex file #\.)))
|
(let ((dot (string-rindex file #\.)))
|
||||||
|
|
|
@ -72,6 +72,12 @@
|
||||||
(test-assert "guile-version>? 10.5"
|
(test-assert "guile-version>? 10.5"
|
||||||
(not (guile-version>? "10.5")))
|
(not (guile-version>? "10.5")))
|
||||||
|
|
||||||
|
(test-assert "version-prefix?"
|
||||||
|
(and (version-prefix? "4.1" "4.1.2")
|
||||||
|
(version-prefix? "4.1" "4.1")
|
||||||
|
(not (version-prefix? "4.1" "4.16.2"))
|
||||||
|
(not (version-prefix? "4.1" "4"))))
|
||||||
|
|
||||||
(test-equal "string-tokenize*"
|
(test-equal "string-tokenize*"
|
||||||
'(("foo")
|
'(("foo")
|
||||||
("foo" "bar" "baz")
|
("foo" "bar" "baz")
|
||||||
|
|
Loading…
Reference in New Issue