summary refs log tree commit diff
path: root/gnu/tests/linux-modules.scm
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2020-04-08 13:00:50 +0200
committerMarius Bakke <mbakke@fastmail.com>2020-04-08 13:00:50 +0200
commit27783023993f9272ce422868d14529159c4a5218 (patch)
tree9013b08aa39e497b1fd8e01a05254278d83f0ff7 /gnu/tests/linux-modules.scm
parentbe1e842ad78ac6c52fc7790f4a3ffd716673c111 (diff)
parentba6f2bda18ed19fa486a9c3e2c3baea6c66c6867 (diff)
downloadguix-27783023993f9272ce422868d14529159c4a5218.tar.gz
Merge branch 'master' into core-updates
 Conflicts:
	etc/news.scm
	gnu/local.mk
	gnu/packages/check.scm
	gnu/packages/cross-base.scm
	gnu/packages/gimp.scm
	gnu/packages/java.scm
	gnu/packages/mail.scm
	gnu/packages/sdl.scm
	gnu/packages/texinfo.scm
	gnu/packages/tls.scm
	gnu/packages/version-control.scm
Diffstat (limited to 'gnu/tests/linux-modules.scm')
-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