tribes/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 13:10:33 +02:00
Code Activity

tests: Make ‘operating-system-with-console-syslog’ public.

Browse Source 
* gnu/tests/install.scm (operating-system-with-console-syslog): Move to…
* gnu/tests.scm (operating-system-with-console-syslog): … here.  New
procedure.

Reviewed-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Change-Id: I015e24525140365d09f22127d366107fdc9ca902
This commit is contained in:
Ludovic Courtès
2025-03-15 19:28:44 +01:00
parent 59bd1337d0
commit caf5869a1d
2 changed files with 21 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
gnu/tests.scm
View File

@@ -53,6 +53,7 @@
%simple-os
simple-operating-system
operating-system-with-console-syslog
system-test
system-test?
@@ -268,6 +269,26 @@ the system under test."
(services (cons* user-services ... %base-services))))
(define (operating-system-with-console-syslog os)
"Return OS with a system log service that writes to /dev/console."
(operating-system
(inherit os)
(services
(modify-services (operating-system-user-services os)
(shepherd-system-log-service-type
config
=>
(system-log-configuration
(inherit config)
(message-destination
#~(lambda (message)
(let ((destinations ((default-message-destination-procedure)
message)))
(if (<= (system-log-message-priority message)
(system-log-priority info))
(cons "/dev/console" destinations)
destinations))))))))))
;;;
;;; Tests.

20
gnu/tests/install.scm
View File

@@ -1784,26 +1784,6 @@ build (current-guix) and then store a couple of full system images.")
;;; Installation through the graphical interface.
;;;
(define (operating-system-with-console-syslog os)
"Return OS with a syslog service that writes to /dev/console."
(operating-system
(inherit os)
(services
(modify-services (operating-system-user-services os)
(shepherd-system-log-service-type
config
=>
(system-log-configuration
(inherit config)
(message-destination
#~(lambda (message)
(let ((destinations ((default-message-destination-procedure)
message)))
(if (<= (system-log-message-priority message)
(system-log-priority info))
(cons "/dev/console" destinations)
destinations))))))))))
(define %root-password "foo")
(define* (gui-test-program marionette