me
/
guix
Archived
1
0
Fork 0
Code

utils: Define 'target-linux?' predicate. 

* guix/utils.scm (target-linux?): New predicate.
* tests/utils.scm
  ("target-linux?"): Test it.
  ("target-mingw?"): Also test ‘target-mingw?’.

Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
master
Maxime Devos 2021-07-14 13:12:46 +02:00 committed by Mathieu Othacehe
parent b4ccf3df0b
commit ef71965c16
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
2 changed files with 24 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
guix/utils.scm
View File

@ -11,6 +11,7 @@
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@ -83,6 +84,7 @@
%current-system
%current-target-system
package-name->name+version
target-linux?
target-mingw?
target-arm32?
target-aarch64?
@ -632,6 +634,11 @@ a character other than '@'."
(idx (values (substring spec 0 idx)
(substring spec (1+ idx))))))
(define* (target-linux? #:optional (target (or (%current-target-system)
(%current-system))))
"Does the operating system of TARGET use the Linux kernel?"
(->bool (string-contains target "linux")))
(define* (target-mingw? #:optional (target (%current-target-system)))
(and target
(string-suffix? "-mingw32" target)))

17
tests/utils.scm
View File

@ -3,6 +3,7 @@
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@ -289,6 +290,22 @@ skip these tests."
(string-closest "hello" '("kikoo" "helo" "hihihi" "halo"))
(string-closest "hello" '("aaaaa" "12345" "hellohello" "h"))))
(test-equal "target-linux?"
'(#t #f #f #t)
(map target-linux?
'("i686-linux-gnu" "i686-w64-mingw32"
;; Checking that "gnu" is present is not sufficient,
;; as GNU/Hurd exists.
"i686-pc-gnu"
;; Some targets have a suffix.
"arm-linux-gnueabihf")))
(test-equal "target-mingw?"
'(#f #f #t)
(map target-mingw?
'("i686-linux-gnu" "i686-pc-gnu"
"i686-w64-mingw32")))
(test-end)
(false-if-exception (delete-file temp-file))