summary refs log tree commit diff
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)
downloadguix-3332f4365bf329c361d650c70e53b8a74ad923bd.tar.gz
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 3b10a6d5ac..eb636873a2 100644
--- a/gnu/tests.scm
+++ b/gnu/tests.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2016, 2017, 2018, 2019, 2020 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.
 ;;;
@@ -74,13 +75,24 @@
                     (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))
 
@@ -90,7 +102,7 @@
             (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 ()
@@ -154,11 +166,13 @@
 (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.
@@ -172,6 +186,7 @@ in REQUIREMENTS."
     (services (cons (service marionette-service-type
                              (marionette-configuration
                               (requirements requirements)
+                              (extensions extensions)
                               (imported-modules imported-modules)))
                     (operating-system-user-services os)))))
 
@@ -281,4 +296,9 @@ result."
   "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