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

* 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
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 21 additions and 20 deletions

View file

@ -53,6 +53,7 @@
%simple-os %simple-os
simple-operating-system simple-operating-system
operating-system-with-console-syslog
system-test system-test
system-test? system-test?
@ -268,6 +269,26 @@ the system under test."
(services (cons* user-services ... %base-services)))) (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. ;;; Tests.

View file

@ -1784,26 +1784,6 @@ build (current-guix) and then store a couple of full system images.")
;;; Installation through the graphical interface. ;;; 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 %root-password "foo")
(define* (gui-test-program marionette (define* (gui-test-program marionette