gnu/tests/linux-modules.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
   3 ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
   4 ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
   5 ;;;
   6 ;;; This file is part of GNU Guix.
   7 ;;;
   8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   9 ;;; under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 3 of the License, or (at
  11 ;;; your option) any later version.
  12 ;;;
  13 ;;; GNU Guix is distributed in the hope that it will be useful, but
  14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 (define-module (gnu tests linux-modules)
  22   #:use-module (gnu packages linux)
  23   #:use-module (gnu services)
  24   #:use-module (gnu services linux)
  25   #:use-module (gnu system)
  26   #:use-module (gnu system vm)
  27   #:use-module (gnu tests)
  28   #:use-module (guix derivations)
  29   #:use-module (guix gexp)
  30   #:use-module (guix modules)
  31   #:use-module (guix packages)
  32   #:use-module (guix monads)
  33   #:use-module (guix store)
  34   #:use-module (guix utils)
  35   #:export (%test-loadable-kernel-modules-0
  36             %test-loadable-kernel-modules-1
  37             %test-loadable-kernel-modules-2))
  38
  39 ;;; Commentary:
  40 ;;;
  41 ;;; Test <operating-system> kernel-loadable-modules.
  42 ;;;
  43 ;;; Code:
  44
  45 (define* (modules-loaded?-program os modules)
  46   "Return an executable store item that, upon being evaluated, will verify
  47 that MODULES are actually loaded."
  48   (program-file
  49    "verify-kernel-modules-loaded.scm"
  50    #~(begin
  51      (use-modules (ice-9 rdelim)
  52                   (ice-9 popen)
  53                   (srfi srfi-1)
  54                   (srfi srfi-13))
  55      (let* ((port (open-input-pipe (string-append #$kmod "/bin/lsmod")))
  56             (lines (string-split (read-string port) #\newline))
  57             (separators (char-set #\space #\tab))
  58             (modules (map (lambda (line)
  59                             (string-take line
  60                                          (or (string-index line separators)
  61                                              0)))
  62                           lines))
  63             (status (close-pipe port)))
  64        (and (= status 0)
  65             (and-map (lambda (module)
  66                        (member module modules string=?))
  67                      '#$modules))))))
  68
  69 (define* (run-loadable-kernel-modules-test module-packages module-names)
  70   "Run a test of an OS having MODULE-PACKAGES, and verify that MODULE-NAMES
  71 are loaded in memory."
  72   (define os
  73     (marionette-operating-system
  74      (operating-system
  75       (inherit (simple-operating-system))
  76       (services (cons (service kernel-module-loader-service-type module-names)
  77                       (operating-system-user-services
  78                        (simple-operating-system))))
  79       (kernel-loadable-modules module-packages))
  80      #:imported-modules '((guix combinators))))
  81   (define vm (virtual-machine os))
  82   (define (test script)
  83     (with-imported-modules '((gnu build marionette))
  84       #~(begin
  85           (use-modules (gnu build marionette)
  86                        (srfi srfi-64))
  87           (define marionette
  88             (make-marionette (list #$vm)))
  89           (mkdir #$output)
  90           (chdir #$output)
  91           (test-begin "loadable-kernel-modules")
  92           (test-assert "script successfully evaluated"
  93             (marionette-eval
  94              '(primitive-load #$script)
  95              marionette))
  96           (test-end)
  97           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
  98   (gexp->derivation "loadable-kernel-modules"
  99                     (test (modules-loaded?-program os module-names))))
 100
 101 (define %test-loadable-kernel-modules-0
 102   (system-test
 103    (name "loadable-kernel-modules-0")
 104    (description "Tests loadable kernel modules facility of <operating-system>
 105 with no extra modules.")
 106    (value (run-loadable-kernel-modules-test '() '()))))
 107
 108 (define %test-loadable-kernel-modules-1
 109   (system-test
 110    (name "loadable-kernel-modules-1")
 111    (description "Tests loadable kernel modules facility of <operating-system>
 112 with one extra module.")
 113    (value (run-loadable-kernel-modules-test
 114            (list ddcci-driver-linux)
 115            '("ddcci")))))
 116
 117 (define %test-loadable-kernel-modules-2
 118   (system-test
 119    (name "loadable-kernel-modules-2")
 120    (description "Tests loadable kernel modules facility of <operating-system>
 121 with two extra modules.")
 122    (value (run-loadable-kernel-modules-test
 123            (list acpi-call-linux-module
 124                  (package
 125                    (inherit ddcci-driver-linux)
 126                    (arguments
 127                     `(#:linux #f
 128                       ,@(strip-keyword-arguments '(#:linux)
 129                                                  (package-arguments
 130                                                   ddcci-driver-linux))))))
 131            '("acpi_call" "ddcci")))))