From 102c36062446663298cf0b340f38a8a703134644 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Thu, 16 Dec 2021 13:37:10 +0100
Subject: tests: docker: Fix it.

The docker tests are broken because the docker overlay doesn't support running
on our own storage overlay. Use the new <virtual-machine> volatile? field to
spawn a VM with a persistent storage and no overlay.

* gnu/tests/docker.scm (run-docker-test): Add the docker-tarball to the gc
roots as the host store is not shared anymore. Spawn a VM without volatile
storage.
(run-docker-system-test): Ditto.
(%test-docker-system): Adapt it to use the image API.
---
 gnu/tests/docker.scm | 51 +++++++++++++++++++++++++++++----------------------
 1 file changed, 29 insertions(+), 22 deletions(-)

(limited to 'gnu/tests/docker.scm')

diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index bc119988b7..6302bd0727 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -18,9 +18,11 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu tests docker)
+  #:use-module (gnu image)
   #:use-module (gnu tests)
   #:use-module (gnu system)
   #:use-module (gnu system file-systems)
+  #:use-module (gnu system image)
   #:use-module (gnu system vm)
   #:use-module (gnu services)
   #:use-module (gnu services dbus)
@@ -35,7 +37,7 @@
   #:use-module (guix monads)
   #:use-module (guix packages)
   #:use-module (guix profiles)
-  #:use-module (guix scripts pack)
+  #:use-module ((guix scripts pack) #:prefix pack:)
   #:use-module (guix store)
   #:use-module (guix tests)
   #:use-module (guix build-system trivial)
@@ -56,15 +58,18 @@
 inside %DOCKER-OS."
   (define os
     (marionette-operating-system
-     %docker-os
+     (operating-system-with-gc-roots
+      %docker-os
+      (list docker-tarball))
      #:imported-modules '((gnu services herd)
                           (guix combinators))))
 
   (define vm
     (virtual-machine
      (operating-system os)
-     (memory-size 700)
-     (disk-image-size (* 1500 (expt 2 20)))
+     (volatile? #f)
+     (memory-size 1024)
+     (disk-image-size (* 3000 (expt 2 20)))
      (port-forwardings '())))
 
   (define test
@@ -173,11 +178,12 @@ standard output device and then enters a new line.")
                                            guest-script-package))
                                     #:hooks '()
                                     #:locales? #f))
-       (tarball (docker-image "docker-pack" profile
-                              #:symlinks '(("/bin/Guile" -> "bin/guile")
-                                           ("aa.scm" -> "a.scm"))
-                              #:entry-point "bin/guile"
-                              #:localstatedir? #t)))
+       (tarball (pack:docker-image
+                 "docker-pack" profile
+                 #:symlinks '(("/bin/Guile" -> "bin/guile")
+                              ("aa.scm" -> "a.scm"))
+                 #:entry-point "bin/guile"
+                 #:localstatedir? #t)))
     (run-docker-test tarball)))
 
 (define %test-docker
@@ -192,19 +198,18 @@ standard output device and then enters a new line.")
 inside %DOCKER-OS."
   (define os
     (marionette-operating-system
-     %docker-os
+     (operating-system-with-gc-roots
+      %docker-os
+      (list tarball))
      #:imported-modules '((gnu services herd)
                           (guix combinators))))
 
   (define vm
     (virtual-machine
      (operating-system os)
-     ;; FIXME: Because we're using the volatile-root setup where the root file
-     ;; system is a tmpfs overlaid over a small root file system, 'docker
-     ;; load' must be able to store the whole image into memory, hence the
-     ;; huge memory requirements.  We should avoid the volatile-root setup
-     ;; instead.
-     (memory-size 4500)
+     (volatile? #f)
+     (disk-image-size (* 5000 (expt 2 20)))
+     (memory-size 2048)
      (port-forwardings '())))
 
   (define test
@@ -293,10 +298,12 @@ inside %DOCKER-OS."
    (description "Run a system image as produced by @command{guix system
 docker-image} inside Docker.")
    (value (with-monad %store-monad
-            (>>= (system-docker-image (operating-system
-                                        (inherit (simple-operating-system))
-                                        ;; Use locales for a single libc to
-                                        ;; reduce space requirements.
-                                        (locale-libcs (list glibc)))
-                                      #:memory-size 1024)
+            (>>= (lower-object
+                  (system-image (os->image
+                                 (operating-system
+                                   (inherit (simple-operating-system))
+                                   ;; Use locales for a single libc to
+                                   ;; reduce space requirements.
+                                   (locale-libcs (list glibc)))
+                                 #:type docker-image-type)))
                  run-docker-system-test)))))
-- 
cgit v1.2.3