Archived
1
0
Fork 0

tests: Support package extensions in the backdoor REPL.

* gnu/tests.scm
  (<marionette-configuration>): Add 'extensions' field.
  (marionette-shepherd-service): Honour the field.
  (with-import-modules-and-extensions): Define a combination
  of 'with-import-modules' and 'with-extensions'.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Maxime Devos 2021-03-30 12:40:14 +02:00 committed by Ludovic Courtès
parent b18f45c21f
commit 3332f4365b
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -2,6 +2,7 @@
;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -74,13 +75,24 @@
(default "/dev/virtio-ports/org.gnu.guix.port.0")) (default "/dev/virtio-ports/org.gnu.guix.port.0"))
(imported-modules marionette-configuration-imported-modules (imported-modules marionette-configuration-imported-modules
(default '())) (default '()))
(extensions marionette-configuration-extensions
(default '())) ; list of packages
(requirements marionette-configuration-requirements ;list of symbols (requirements marionette-configuration-requirements ;list of symbols
(default '()))) (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) (define (marionette-shepherd-service config)
"Return the Shepherd service for the marionette REPL" "Return the Shepherd service for the marionette REPL"
(match config (match config
(($ <marionette-configuration> device imported-modules requirement) (($ <marionette-configuration> device imported-modules extensions
requirement)
(list (shepherd-service (list (shepherd-service
(provision '(marionette)) (provision '(marionette))
@ -90,7 +102,7 @@
(modules '((ice-9 match) (modules '((ice-9 match)
(srfi srfi-9 gnu))) (srfi srfi-9 gnu)))
(start (start
(with-imported-modules imported-modules (with-imported-modules-and-extensions imported-modules extensions
#~(lambda () #~(lambda ()
(define (self-quoting? x) (define (self-quoting? x)
(letrec-syntax ((one-of (syntax-rules () (letrec-syntax ((one-of (syntax-rules ()
@ -154,11 +166,13 @@
(define* (marionette-operating-system os (define* (marionette-operating-system os
#:key #:key
(imported-modules '()) (imported-modules '())
(extensions '())
(requirements '())) (requirements '()))
"Return a marionetteed variant of OS such that OS can be used as a "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 in a virtual machine--i.e., controlled from the host system. The
marionette service in the guest is started after the Shepherd services listed 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 (operating-system
(inherit os) (inherit os)
;; Make sure the guest dies on error. ;; Make sure the guest dies on error.
@ -172,6 +186,7 @@ in REQUIREMENTS."
(services (cons (service marionette-service-type (services (cons (service marionette-service-type
(marionette-configuration (marionette-configuration
(requirements requirements) (requirements requirements)
(extensions extensions)
(imported-modules imported-modules))) (imported-modules imported-modules)))
(operating-system-user-services os))))) (operating-system-user-services os)))))
@ -281,4 +296,9 @@ result."
"Return the list of system tests." "Return the list of system tests."
(reverse (fold-system-tests cons '()))) (reverse (fold-system-tests cons '())))
;; Local Variables:
;; eval: (put 'with-imported-modules-and-extensions 'scheme-indent-function 2)
;; End:
;;; tests.scm ends here ;;; tests.scm ends here