summary refs log tree commit diff
path: root/gnu/tests
diff options
context:
space:
mode:
authorBrice Waegeneire <brice@waegenei.re>2020-04-05 07:28:03 +0200
committerDanny Milosavljevic <dannym@scratchpost.org>2020-04-05 13:07:13 +0200
commit044d1478c9a63a64547c9cc320008f8d8fbf6791 (patch)
tree622a7ba842a075a3cc4ac8b433a2161e8bbc8400 /gnu/tests
parent8c88e242292db9b35b4ae6ad788a0f8f3c94bb53 (diff)
downloadguix-044d1478c9a63a64547c9cc320008f8d8fbf6791.tar.gz
gnu: Add kernel-module-loader-service.
* doc/guix.texi (Linux Services): Add a new subsection and document the
new service and its configuration.
* gnu/services/linux.scm (kernel-module-loader-service-type): New type.
(kernel-module-loader-shepherd-service): New procedure.
* gnu/tests/linux-modules.scm (module-loader-program): Procedure
removed.
(modules-loaded?-program): New procedure.
(run-loadable-kernel-modules-test): 'module-loader-program' procedure
replaced by the new one.
[os]: Use 'kernel-module-loader-service'.

Signed-off-by: Danny Milosavljevic <dannym@scratchpost.org>
Diffstat (limited to 'gnu/tests')
-rw-r--r--gnu/tests/linux-modules.scm45
1 files changed, 32 insertions, 13 deletions
diff --git a/gnu/tests/linux-modules.scm b/gnu/tests/linux-modules.scm
index 39e11587c6..788bdc848a 100644
--- a/gnu/tests/linux-modules.scm
+++ b/gnu/tests/linux-modules.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
 ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
+;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,6 +20,8 @@
 
 (define-module (gnu tests linux-modules)
   #:use-module (gnu packages linux)
+  #:use-module (gnu services)
+  #:use-module (gnu services linux)
   #:use-module (gnu system)
   #:use-module (gnu system vm)
   #:use-module (gnu tests)
@@ -37,25 +40,40 @@
 ;;;
 ;;; Code:
 
-(define* (module-loader-program os modules)
-  "Return an executable store item that, upon being evaluated, will dry-run
-load MODULES."
+(define* (modules-loaded?-program os modules)
+  "Return an executable store item that, upon being evaluated, will verify
+that MODULES are actually loaded."
   (program-file
-   "load-kernel-modules.scm"
-   (with-imported-modules (source-module-closure '((guix build utils)))
-     #~(begin
-         (use-modules (guix build utils))
-         (for-each (lambda (module)
-                     (invoke (string-append #$kmod "/bin/modprobe") "-n" "--"
-                             module))
-                   '#$modules)))))
+   "verify-kernel-modules-loaded.scm"
+   #~(begin
+     (use-modules (ice-9 rdelim)
+                  (ice-9 popen)
+                  (srfi srfi-1)
+                  (srfi srfi-13))
+     (let* ((port (open-input-pipe (string-append #$kmod "/bin/lsmod")))
+            (lines (string-split (read-string port) #\newline))
+            (separators (char-set #\space #\tab))
+            (modules (map (lambda (line)
+                            (string-take line
+                                         (or (string-index line separators)
+                                             0)))
+                          lines))
+            (status (close-pipe port)))
+       (and (= status 0)
+            (and-map (lambda (module)
+                       (member module modules string=?))
+                     '#$modules))))))
 
 (define* (run-loadable-kernel-modules-test module-packages module-names)
-  "Run a test of an OS having MODULE-PACKAGES, and modprobe MODULE-NAMES."
+  "Run a test of an OS having MODULE-PACKAGES, and verify that MODULE-NAMES
+are loaded in memory."
   (define os
     (marionette-operating-system
      (operating-system
       (inherit (simple-operating-system))
+      (services (cons (service kernel-module-loader-service-type module-names)
+                      (operating-system-user-services
+                       (simple-operating-system))))
       (kernel-loadable-modules module-packages))
      #:imported-modules '((guix combinators))))
   (define vm (virtual-machine os))
@@ -75,7 +93,8 @@ load MODULES."
              marionette))
           (test-end)
           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-  (gexp->derivation "loadable-kernel-modules" (test (module-loader-program os module-names))))
+  (gexp->derivation "loadable-kernel-modules"
+                    (test (modules-loaded?-program os module-names))))
 
 (define %test-loadable-kernel-modules-0
   (system-test