;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016-2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
(define-module (gnu tests)
#:use-module (guix gexp)
- #:use-module (guix utils)
+ #:use-module (guix diagnostics)
#:use-module (guix records)
#:use-module ((guix ui) #:select (warn-about-load-error))
#:use-module (gnu bootloader)
marionette-operating-system
define-os-with-source
+ %simple-os
simple-operating-system
system-test
(default "/dev/virtio-ports/org.gnu.guix.port.0"))
(imported-modules marionette-configuration-imported-modules
(default '()))
+ (extensions marionette-configuration-extensions
+ (default '())) ; list of packages
(requirements marionette-configuration-requirements ;list of symbols
(default '())))
+;; Hack: avoid indenting code beyond column 80 in marionette-shepherd-service.
+(define-syntax-rule (with-imported-modules-and-extensions imported-modules
+ extensions
+ gexp)
+ (with-imported-modules imported-modules
+ (with-extensions extensions
+ gexp)))
+
(define (marionette-shepherd-service config)
"Return the Shepherd service for the marionette REPL"
(match config
- (($ <marionette-configuration> device imported-modules requirement)
+ (($ <marionette-configuration> device imported-modules extensions
+ requirement)
(list (shepherd-service
(provision '(marionette))
(modules '((ice-9 match)
(srfi srfi-9 gnu)))
(start
- (with-imported-modules imported-modules
+ (with-imported-modules-and-extensions imported-modules extensions
#~(lambda ()
(define (self-quoting? x)
(letrec-syntax ((one-of (syntax-rules ()
(service-type (name 'marionette-repl)
(extensions
(list (service-extension shepherd-root-service-type
- marionette-shepherd-service)))))
+ marionette-shepherd-service)))
+ (description "The @dfn{marionette} service allows a guest
+system (virtual machine) to be manipulated by the host. It is used for system
+tests.")))
(define* (marionette-operating-system os
#:key
(imported-modules '())
+ (extensions '())
(requirements '()))
"Return a marionetteed variant of OS such that OS can be used as a
marionette in a virtual machine--i.e., controlled from the host system. The
marionette service in the guest is started after the Shepherd services listed
-in REQUIREMENTS."
+in REQUIREMENTS. The packages in the list EXTENSIONS are made available from
+the backdoor REPL."
(operating-system
(inherit os)
;; Make sure the guest dies on error.
(services (cons (service marionette-service-type
(marionette-configuration
(requirements requirements)
+ (extensions extensions)
(imported-modules imported-modules)))
(operating-system-user-services os)))))
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (target "/dev/sdX")))
+ (targets '("/dev/sdX"))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
"Return the list of system tests."
(reverse (fold-system-tests cons '())))
+
+;; Local Variables:
+;; eval: (put 'with-imported-modules-and-extensions 'scheme-indent-function 2)
+;; End:
+
;;; tests.scm ends here