services: databases: Don't specify a default postgresql version.

[jackhill/guix/guix.git] / gnu / tests / linux-modules.scm

diff --git a/gnu/tests/linux-modules.scm b/gnu/tests/linux-modules.scm
index 39e1158..953b132 100644 (file)
--- 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,14 +20,18 @@
 
 (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)
   #:use-module (guix derivations)
   #:use-module (guix gexp)
   #:use-module (guix modules)
+  #:use-module (guix packages)
   #:use-module (guix monads)
   #:use-module (guix store)
+  #:use-module (guix utils)
   #:export (%test-loadable-kernel-modules-0
             %test-loadable-kernel-modules-1
             %test-loadable-kernel-modules-2))
@@ -37,25 +42,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 +95,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
@@ -99,5 +120,12 @@ with one extra module.")
    (description "Tests loadable kernel modules facility of <operating-system>
 with two extra modules.")
    (value (run-loadable-kernel-modules-test
-           (list acpi-call-linux-module ddcci-driver-linux)
+           (list acpi-call-linux-module
+                 (package
+                   (inherit ddcci-driver-linux)
+                   (arguments
+                    `(#:linux #f
+                      ,@(strip-keyword-arguments '(#:linux)
+                                                 (package-arguments
+                                                  ddcci-driver-linux))))))
            '("acpi_call" "ddcci")))))