From ef71965c162ff19c7b4b85889b0330d7c428dda5 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Wed, 14 Jul 2021 13:12:46 +0200 Subject: utils: Define 'target-linux?' predicate. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * 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 --- guix/utils.scm | 7 +++++++ tests/utils.scm | 17 +++++++++++++++++ 2 files changed, 24 insertions(+) diff --git a/guix/utils.scm b/guix/utils.scm index 65d709a01f..1ac17b3657 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -11,6 +11,7 @@ ;;; Copyright © 2020 Maxim Cournoyer ;;; Copyright © 2021 Simon Tournier ;;; Copyright © 2021 Chris Marusich +;;; Copyright © 2021 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; @@ -83,6 +84,7 @@ (define-module (guix utils) %current-system %current-target-system package-name->name+version + target-linux? target-mingw? target-arm32? target-aarch64? @@ -632,6 +634,11 @@ (define* (package-name->name+version spec (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 7fcbb25552..e170070907 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2016 Mathieu Lirzin ;;; Copyright © 2021 Simon Tournier +;;; Copyright © 2021 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; @@ -289,6 +290,22 @@ (define (test-compression/decompression method run?) (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)) -- cgit v1.2.3