ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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 ;;; 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 @@ (define-module (guix utils)
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 @@ (define (guile-version>? str)
(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 #\.)))

6
tests/utils.scm
View file

@ -72,6 +72,12 @@ (define temp-file
(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")