02/04: utils: Add 'version-prefix?'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 437f62f02a1b8c89b8ab39ecd53926489fac42db
Author: Ludovic Courtès <address@hidden>
Date:   Sun May 13 12:16:08 2018 +0200

    utils: Add 'version-prefix?'.
    
    * guix/utils.scm (version-prefix?): New procedure.
    * tests/utils.scm ("version-prefix?"): New test.
---
 guix/utils.scm  | 24 +++++++++++++++++++++++-
 tests/utils.scm |  6 ++++++
 2 files changed, 29 insertions(+), 1 deletion(-)

diff --git a/guix/utils.scm b/guix/utils.scm
index 92e45de..e9efea5 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 
<address@hidden>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès 
<address@hidden>
 ;;; Copyright © 2013, 2014, 2015 Mark H Weaver <address@hidden>
 ;;; Copyright © 2014 Eric Bavier <address@hidden>
 ;;; Copyright © 2014 Ian Denhardt <address@hidden>
@@ -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 197182a..3015b21 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")