tests/offload.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (tests offload)
  20   #:use-module (guix scripts offload)
  21   #:use-module (srfi srfi-64))
  22
  23 \f
  24 (test-begin "offload")
  25
  26 (define-syntax-rule (expose-internal-definitions s1 s2 ...)
  27   (begin
  28     (define s1 (@@ (guix scripts offload) s1))
  29     (define s2 (@@ (guix scripts offload) s2)) ...))
  30
  31 (expose-internal-definitions machine-matches?
  32                              build-requirements-system
  33                              build-requirements-features
  34                              build-machine-system
  35                              build-machine-systems
  36                              %build-machine-system
  37                              %build-machine-systems
  38                              build-machine-features)
  39
  40 (define (deprecated-build-machine system)
  41   (build-machine
  42    (name "m1")
  43    (user "dummy")
  44    (host-key "some-key")
  45    (system system)))
  46
  47 (define (new-build-machine systems)
  48   (build-machine
  49    (name "m1")
  50    (user "dummy")
  51    (host-key "some-key")
  52    (systems systems)))
  53
  54 ;;; Test that deprecated build-machine definitions still work.
  55 (test-assert (machine-matches? (deprecated-build-machine "i686-linux")
  56                                (build-requirements
  57                                 (system "i686-linux"))))
  58
  59
  60 (test-assert (machine-matches? (new-build-machine '("i686-linux"))
  61                                (build-requirements
  62                                 (system "i686-linux"))))
  63
  64 ;;; A build machine can act as more than one system type, thanks to QEMU
  65 ;;; emulation.
  66 (test-assert (machine-matches? (new-build-machine '("armhf-linux"
  67                                                     "aarch64-linux"
  68                                                     "i686-linux"
  69                                                     "x86_64-linux"))
  70                                (build-requirements
  71                                 (system "armhf-linux"))))