summaryrefslogtreecommitdiff
path: root/gnu/tests.scm
diff options
context:
space:
mode:
authorMaxime Devos <maximedevos@telenet.be>2021-03-30 12:40:14 +0200
committerLudovic Courtès <ludo@gnu.org>2021-04-12 18:42:22 +0200
commit3332f4365bf329c361d650c70e53b8a74ad923bd (patch)
treec9c71cf1b482ef9b15a009004be29a2f2303b169 /gnu/tests.scm
parentb18f45c21f5d697d384a7bd5c9d3ee314bba9e35 (diff)
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>
Diffstat (limited to 'gnu/tests.scm')
-rw-r--r--gnu/tests.scm26
1 files changed, 23 insertions, 3 deletions
diff --git a/gnu/tests.scm b/gnu/tests.scm
index 3b10a6d5ac5..eb636873a2c 100644
--- a/gnu/tests.scm
+++ b/gnu/tests.scm
@@ -2,6 +2,7 @@
2;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> 3;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
4;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> 4;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
5;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
5;;; 6;;;
6;;; This file is part of GNU Guix. 7;;; This file is part of GNU Guix.
7;;; 8;;;
@@ -74,13 +75,24 @@
74 (default "/dev/virtio-ports/org.gnu.guix.port.0")) 75 (default "/dev/virtio-ports/org.gnu.guix.port.0"))
75 (imported-modules marionette-configuration-imported-modules 76 (imported-modules marionette-configuration-imported-modules
76 (default '())) 77 (default '()))
78 (extensions marionette-configuration-extensions
79 (default '())) ; list of packages
77 (requirements marionette-configuration-requirements ;list of symbols 80 (requirements marionette-configuration-requirements ;list of symbols
78 (default '()))) 81 (default '())))
79 82
83;; Hack: avoid indenting code beyond column 80 in marionette-shepherd-service.
84(define-syntax-rule (with-imported-modules-and-extensions imported-modules
85 extensions
86 gexp)
87 (with-imported-modules imported-modules
88 (with-extensions extensions
89 gexp)))
90
80(define (marionette-shepherd-service config) 91(define (marionette-shepherd-service config)
81 "Return the Shepherd service for the marionette REPL" 92 "Return the Shepherd service for the marionette REPL"
82 (match config 93 (match config
83 (($ <marionette-configuration> device imported-modules requirement) 94 (($ <marionette-configuration> device imported-modules extensions
95 requirement)
84 (list (shepherd-service 96 (list (shepherd-service
85 (provision '(marionette)) 97 (provision '(marionette))
86 98
@@ -90,7 +102,7 @@
90 (modules '((ice-9 match) 102 (modules '((ice-9 match)
91 (srfi srfi-9 gnu))) 103 (srfi srfi-9 gnu)))
92 (start 104 (start
93 (with-imported-modules imported-modules 105 (with-imported-modules-and-extensions imported-modules extensions
94 #~(lambda () 106 #~(lambda ()
95 (define (self-quoting? x) 107 (define (self-quoting? x)
96 (letrec-syntax ((one-of (syntax-rules () 108 (letrec-syntax ((one-of (syntax-rules ()
@@ -154,11 +166,13 @@
154(define* (marionette-operating-system os 166(define* (marionette-operating-system os
155 #:key 167 #:key
156 (imported-modules '()) 168 (imported-modules '())
169 (extensions '())
157 (requirements '())) 170 (requirements '()))
158 "Return a marionetteed variant of OS such that OS can be used as a 171 "Return a marionetteed variant of OS such that OS can be used as a
159marionette in a virtual machine--i.e., controlled from the host system. The 172marionette in a virtual machine--i.e., controlled from the host system. The
160marionette service in the guest is started after the Shepherd services listed 173marionette service in the guest is started after the Shepherd services listed
161in REQUIREMENTS." 174in REQUIREMENTS. The packages in the list EXTENSIONS are made available from
175the backdoor REPL."
162 (operating-system 176 (operating-system
163 (inherit os) 177 (inherit os)
164 ;; Make sure the guest dies on error. 178 ;; Make sure the guest dies on error.
@@ -172,6 +186,7 @@ in REQUIREMENTS."
172 (services (cons (service marionette-service-type 186 (services (cons (service marionette-service-type
173 (marionette-configuration 187 (marionette-configuration
174 (requirements requirements) 188 (requirements requirements)
189 (extensions extensions)
175 (imported-modules imported-modules))) 190 (imported-modules imported-modules)))
176 (operating-system-user-services os))))) 191 (operating-system-user-services os)))))
177 192
@@ -281,4 +296,9 @@ result."
281 "Return the list of system tests." 296 "Return the list of system tests."
282 (reverse (fold-system-tests cons '()))) 297 (reverse (fold-system-tests cons '())))
283 298
299
300;; Local Variables:
301;; eval: (put 'with-imported-modules-and-extensions 'scheme-indent-function 2)
302;; End:
303
284;;; tests.scm ends here 304;;; tests.scm ends here