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:
parent
b18f45c21f
commit
3332f4365b
1 changed files with 23 additions and 3 deletions
|
@ -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
|
||||||
|
|
Reference in a new issue