aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-05-13 12:16:08 +0200
committerLudovic Courtès <ludo@gnu.org>2018-05-13 13:29:27 +0200
commit437f62f02a1b8c89b8ab39ecd53926489fac42db (patch)
treee7d995116540267b2864b51db778e54b2994606d
parente18e7cb9f4c08efb3b7233dd1042553924594743 (diff)
downloadguix-437f62f02a1b8c89b8ab39ecd53926489fac42db.tar
guix-437f62f02a1b8c89b8ab39ecd53926489fac42db.tar.gz
utils: Add 'version-prefix?'.
* guix/utils.scm (version-prefix?): New procedure. * tests/utils.scm ("version-prefix?"): New test.
-rw-r--r--guix/utils.scm24
-rw-r--r--tests/utils.scm6
2 files changed, 29 insertions, 1 deletions
diff --git a/guix/utils.scm b/guix/utils.scm
index 92e45de616..e9efea5866 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -1,5 +1,5 @@
;;; 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 © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net>
@@ -84,6 +84,7 @@
version-major+minor
version-major
guile-version>?
+ version-prefix?
string-replace-substring
arguments-from-environment-variable
file-extension
@@ -521,6 +522,27 @@ minor version numbers from version-string."
(micro-version))
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)
"Return the extension of FILE or #f if there is none."
(let ((dot (string-rindex file #\.)))
diff --git a/tests/utils.scm b/tests/utils.scm
index 197182acf7..3015b21b23 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -72,6 +72,12 @@
(test-assert "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*"
'(("foo")
("foo" "bar" "baz")