From 437f62f02a1b8c89b8ab39ecd53926489fac42db Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 13 May 2018 12:16:08 +0200
Subject: 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 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")
-- 
cgit 1.4.1