10/12: tests: docker: Fix it.

[guix-commits]

mothacehe pushed a commit to branch wip-image
in repository guix.

commit 02e91a8fee7edd5e4854961c0b25f25d319ae321
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Thu Dec 16 13:37:10 2021 +0100

    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(-)

diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index bc11998..6302bd0 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)))))