projects/guix·blob javascript-team · refs

112 lines · 3.9 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2024 Richard Sent <[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 (gnu tests sddm)
20 #:use-module (gnu bootloader)
21 #:use-module (gnu bootloader grub)
22 #:use-module (gnu packages)
23 #:use-module (gnu packages ocr)
24 #:use-module (gnu packages xorg)
25 #:use-module (gnu services)
26 #:use-module (gnu services desktop)
27 #:use-module (gnu services sddm)
28 #:use-module (gnu services xorg)
29 #:use-module (gnu system)
30 #:use-module (gnu system vm)
31 #:use-module (gnu tests)
32 #:use-module (guix gexp)
33 #:use-module (guix modules)
34 #:use-module (srfi srfi-1)
35 #:export (%test-sddm))
36
37(define %sddm-os
38 (operating-system
39 (inherit %simple-os)
40 (services
41 (cons* (service sddm-service-type)
42 (modify-services %desktop-services
43 (delete gdm-service-type))))))
44
45(define (run-sddm-test)
46 "Run tests in %SDDM-OS."
47
48 (define os (marionette-operating-system
49 %sddm-os
50 #:imported-modules (source-module-closure
51 '((gnu services herd)))))
52
53 (define vm (virtual-machine
54 (operating-system os)
55 ;; Test may nondeterministically fail with default memory size.
56 (memory-size 1024)))
57
58 (define test
59 (with-imported-modules (source-module-closure
60 '((gnu build marionette)))
61 #~(begin
62 (use-modules (gnu build marionette)
63 (srfi srfi-26)
64 (srfi srfi-64))
65
66 (let ((marionette (make-marionette (list #$vm))))
67
68 (test-runner-current (system-test-runner #$output))
69 (test-begin "sddm")
70
71 (test-assert "service is running"
72 (marionette-eval
73 '(begin
74 (use-modules (gnu services herd))
75 ;; sddm's shepherd service is called xorg-server
76 (start-service 'xorg-server))
77 marionette))
78
79 (test-assert "service can be stopped"
80 (marionette-eval
81 '(begin
82 (use-modules (gnu services herd))
83 (stop-service 'xorg-server))
84 marionette))
85
86 (test-assert "service can be restarted"
87 (marionette-eval
88 '(begin
89 (use-modules (gnu services herd))
90 (restart-service 'xorg-server))
91 marionette))
92
93 (test-assert "login screen up"
94 ;; GNU Ocrad fails to recognize any text, so use Tesseract.
95 (wait-for-screen-text marionette
96 ;; Login button not recognized, use SDDM's
97 ;; welcome message.
98 (cut string-contains <>
99 "Select your user and enter password")
100 #:ocr #$(file-append tesseract-ocr
101 "/bin/tesseract")
102 #:timeout 60))
103
104 (test-end)))))
105
106 (gexp->derivation "sddm-test" test))
107
108(define %test-sddm
109 (system-test
110 (name "sddm")
111 (description "Basic tests for the SDDM service.")
112 (value (run-sddm-test))))