kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

utils: Add 'version-prefix?'.

Browse Source 
* guix/utils.scm (version-prefix?): New procedure.
* tests/utils.scm ("version-prefix?"): New test.
This commit is contained in:
Ludovic Courtès 2018-05-13 12:16:08 +02:00
parent e18e7cb9f4
commit 437f62f02a
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 29 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
guix/utils.scm
View File

@ -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 #\.)))

6
tests/utils.scm
View File

@ -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")