diff options
| author | Maxime Devos <maximedevos@telenet.be> | 2021-03-30 12:40:14 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2021-04-12 18:42:22 +0200 |
| commit | 3332f4365bf329c361d650c70e53b8a74ad923bd (patch) | |
| tree | c9c71cf1b482ef9b15a009004be29a2f2303b169 /gnu/tests.scm | |
| parent | b18f45c21f5d697d384a7bd5c9d3ee314bba9e35 (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.scm | 26 |
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 |
| 159 | marionette in a virtual machine--i.e., controlled from the host system. The | 172 | marionette in a virtual machine--i.e., controlled from the host system. The |
| 160 | marionette service in the guest is started after the Shepherd services listed | 173 | marionette service in the guest is started after the Shepherd services listed |
| 161 | in REQUIREMENTS." | 174 | in REQUIREMENTS. The packages in the list EXTENSIONS are made available from |
| 175 | the 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 |
