projects/guix·blob javascript-team · refs

191 lines · 7.4 KiB

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