01/22: utils: Define 'target-linux?' predicate.

[guix-commits]

mothacehe pushed a commit to branch core-updates
in repository guix.

commit ef71965c162ff19c7b4b85889b0330d7c428dda5
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Wed Jul 14 13:12:46 2021 +0200

    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>
---
 guix/utils.scm  |  7 +++++++
 tests/utils.scm | 17 +++++++++++++++++
 2 files changed, 24 insertions(+)

diff --git a/guix/utils.scm b/guix/utils.scm
index 65d709a..1ac17b3 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -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)))
diff --git a/tests/utils.scm b/tests/utils.scm
index 7fcbb25..e170070 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -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))