projects/guix·blob javascript-team · refs

257 lines · 8.7 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2025 Ian Eure <[email protected]>
3;;;
4;;; This file is part of GNU Guix.
5;;;
6;;; GNU Guix is free software; you can redistribute it and/or modify it
7;;; under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 3 of the License, or (at
9;;; your option) any later version.
10;;;
11;;; GNU Guix is distributed in the hope that it will be useful, but
12;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19(define-module (tests services xorg)
20 #:use-module (guix diagnostics)
21 #:use-module (guix packages)
22 #:use-module (gnu packages xorg)
23 #:use-module (gnu bootloader)
24 #:use-module (gnu bootloader grub)
25 #:use-module (gnu services)
26 #:use-module (gnu services base)
27 #:use-module (gnu services desktop)
28 #:use-module (gnu services lightdm)
29 #:use-module (gnu services xorg)
30 #:use-module (gnu system)
31 #:use-module (gnu system keyboard)
32 #:use-module (gnu system file-systems)
33 #:use-module ((srfi srfi-1) #:select (find))
34 #:use-module (srfi srfi-64))
35
36;;; Tests for the (gnu services xorg) module.
37
38(define %config-empty (xorg-configuration))
39
40(define %default-server (xorg-configuration-server %config-empty))
41
42
43
44(test-begin "merge-xorg-configurations")
45
46(define merge-xorg-configurations
47 (@@ (gnu services xorg) merge-xorg-configurations))
48
49(define gdm-configuration-xorg
50 (@@ (gnu services xorg) gdm-configuration-xorg))
51
52;; keyboard-layout tests.
53
54(define %config-xorg-keyboard-layout-1
55 (xorg-configuration
56 (keyboard-layout (keyboard-layout "us" #:options '("ctrl:nocaps")))))
57
58(define %config-xorg-keyboard-layout-2
59 (xorg-configuration
60 (keyboard-layout (keyboard-layout "us" #:options '("ctrl:esc")))))
61
62(test-equal "later keyboard layouts replace earlier defaults"
63 (keyboard-layout "us" #:options '("ctrl:nocaps"))
64 (xorg-configuration-keyboard-layout
65 (merge-xorg-configurations
66 (list %config-empty %config-xorg-keyboard-layout-1))))
67
68(test-equal "later keyboard layouts replace earlier customizations"
69 (keyboard-layout "us" #:options '("ctrl:esc"))
70 (xorg-configuration-keyboard-layout
71 (merge-xorg-configurations (list %config-empty
72 %config-xorg-keyboard-layout-1
73 %config-xorg-keyboard-layout-2))))
74
75;; server, server-arguments tests.
76
77(define %custom-server-1
78 (package
79 (inherit xorg-server)
80 (name "fake-xorg-server")))
81
82(define %custom-server-2
83 (package
84 (inherit xorg-server)
85 (name "another-fake-xorg-server")))
86
87(define %custom-server-1-arguments
88 (cons "-nosilk" %default-xorg-server-arguments))
89
90(define %custom-server-2-arguments
91 (cons* "-logverbose" "9" %default-xorg-server-arguments))
92
93(define %config-custom-server-1
94 (xorg-configuration
95 (server %custom-server-1)))
96
97(define %config-custom-server-2
98 (xorg-configuration
99 (server %custom-server-2)))
100
101(define %config-custom-server-1-and-arguments
102 (xorg-configuration
103 (inherit %config-custom-server-1)
104 (server-arguments %custom-server-1-arguments)))
105
106(define %config-custom-server-2-and-arguments
107 (xorg-configuration
108 (inherit %config-custom-server-2)
109 (server-arguments %custom-server-2-arguments)))
110
111(test-equal "custom server is prioritized over earlier default"
112 %custom-server-1
113 (xorg-configuration-server
114 (merge-xorg-configurations (list %config-empty
115 %config-custom-server-1))))
116
117(test-equal "custom server preserves arguments"
118 (list %custom-server-1 %custom-server-1-arguments)
119 (let ((cfg (merge-xorg-configurations
120 (list
121 %config-empty
122 %config-custom-server-1-and-arguments))))
123 (list (xorg-configuration-server cfg)
124 (xorg-configuration-server-arguments cfg))))
125
126(test-equal "later custom arguments replace earlier"
127 (list %custom-server-2 %custom-server-2-arguments)
128 (let ((cfg (merge-xorg-configurations
129 (list
130 %config-empty
131 %config-custom-server-1-and-arguments
132 %config-custom-server-2-and-arguments))))
133 (list (xorg-configuration-server cfg)
134 (xorg-configuration-server-arguments cfg))))
135
136(test-equal "custom server is prioritized over later default"
137 %custom-server-1
138 (xorg-configuration-server
139 (merge-xorg-configurations (list %config-custom-server-1
140 %config-empty))))
141
142(test-equal "custom arguments are prioritized over earlier custom server"
143 %custom-server-2-arguments
144 (xorg-configuration-server-arguments
145 (merge-xorg-configurations
146 (list
147 (xorg-configuration (server %custom-server-1))
148 (xorg-configuration (server-arguments %custom-server-2-arguments))))))
149
150(test-equal "later custom servers are prioritized over earlier 1/3"
151 %custom-server-2
152 (xorg-configuration-server
153 (merge-xorg-configurations (list %config-custom-server-1
154 %config-empty
155 %config-custom-server-2))))
156
157(test-equal "later custom servers are prioritized over earlier 2/3"
158 %custom-server-2
159 (xorg-configuration-server
160 (merge-xorg-configurations (list %config-empty
161 %config-custom-server-1
162 %config-custom-server-2))))
163
164(test-equal "later custom servers are prioritized over earlier 3/3"
165 %custom-server-1
166 (xorg-configuration-server
167 (merge-xorg-configurations (list %config-empty
168 %config-custom-server-1))))
169
170(test-equal "in the context of an operating-system"
171 %custom-server-2
172 (let ((os (operating-system
173 (host-name "test")
174 (bootloader
175 (bootloader-configuration
176 (bootloader grub-bootloader)
177 (targets '("/dev/sdX"))))
178 (file-systems
179 (cons
180 (file-system
181 (device (file-system-label "my-root"))
182 (mount-point "/")
183 (type "ext4"))
184 %base-file-systems))
185 (services
186 (cons*
187 (simple-service 'server-2 gdm-service-type
188 %config-custom-server-2)
189 (simple-service 'server-1 gdm-service-type
190 %config-custom-server-1)
191 (service gdm-service-type)
192 %base-services)))))
193 (xorg-configuration-server
194 (gdm-configuration-xorg
195 (service-value
196 (fold-services
197 (operating-system-services os)
198 #:target-type gdm-service-type))))))
199
200;; extra-config tests.
201
202(let ((snippet-one "# First")
203 (snippet-two "# Second"))
204 (test-equal "extra configurations append"
205 (list snippet-one snippet-two)
206 (xorg-configuration-extra-config
207 (merge-xorg-configurations
208 (list (xorg-configuration (extra-config (list snippet-one)))
209 (xorg-configuration (extra-config (list snippet-two))))))))
210
211;; drivers tests.
212
213(define %drivers-custom-1 '("done"))
214(define %drivers-custom-2 '("dtwo"))
215
216(test-equal "drivers append"
217 (append %drivers-custom-1 %drivers-custom-2)
218 (xorg-configuration-drivers
219 (merge-xorg-configurations
220 (list
221 (xorg-configuration (drivers %drivers-custom-1))
222 (xorg-configuration (drivers %drivers-custom-2))))))
223
224;; regression tests.
225
226;; https://codeberg.org/guix/guix/issues/5267
227(test-equal "https://codeberg.org/guix/guix/issues/5267"
228 (xorg-configuration-keyboard-layout %config-xorg-keyboard-layout-1)
229 (let ((os (operating-system
230 (host-name "test")
231 (bootloader
232 (bootloader-configuration
233 (bootloader grub-bootloader)
234 (targets '("/dev/sdX"))))
235 (file-systems
236 (cons
237 (file-system
238 (device (file-system-label "my-root"))
239 (mount-point "/")
240 (type "ext4"))
241 %base-file-systems))
242 (services
243 (cons*
244 (service lightdm-service-type
245 (lightdm-configuration
246 (xorg-configuration
247 %config-xorg-keyboard-layout-1)))
248 (modify-services %desktop-services
249 (delete gdm-service-type)))))))
250 (xorg-configuration-keyboard-layout
251 (lightdm-configuration-xorg-configuration
252 (service-value
253 (fold-services
254 (operating-system-services os)
255 #:target-type lightdm-service-type))))))
256
257(test-end "merge-xorg-configurations")