[bug#34039] [WIP] tests: Make docker system test more comprehensive.

[bug#34039] [WIP] tests: Make docker system test more comprehensive.

[Danny Milosavljevic]

This system test fails with the error message "Read-only store".

* gnu/tests/docker.scm (run-docker-test): Add test
"pack guest OS as docker image, load it and run it".
(%test-docker)[description]: Modify.
---
 gnu/tests/docker.scm | 35 +++++++++++++++++++++++++++++++++--
 1 file changed, 33 insertions(+), 2 deletions(-)

diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 973a84c55..32fae82a8 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -1,4 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
 ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -27,6 +28,7 @@
   #:use-module (gnu services docker)
   #:use-module (gnu services desktop)
   #:use-module (gnu packages docker)
+  #:use-module (gnu packages package-management)
   #:use-module (guix gexp)
   #:use-module (guix store)
   #:export (%test-docker))
@@ -79,7 +81,7 @@
                      ((pid) (number? pid))))))
              marionette))
 
-          (test-eq "fetch version"
+          (test-eq "fetch docker version"
             0
             (marionette-eval
              `(begin
@@ -87,6 +89,35 @@
                          "version"))
              marionette))
 
+          (test-eq "pack guest OS as docker image, load it and run it"
+            0
+            (marionette-eval
+             `(begin
+                (define slurp
+                  (lambda args
+                    (let* ((port (apply open-pipe* OPEN_READ args))
+                           (output (read-line port))
+                           (status (close-pipe port)))
+                      output)))
+                (let* ((tar-name (slurp ,(string-append #$guix "/bin/guix")
+                                        "system" "docker-image"
+                                        ,(string-append #$guix
+                                                        ; MISSING "/share/guile/site/2.2/gnu/system/examples/docker-image.tmpl"
+                                                        "/share/guile/site/2.2/gnu/system/examples/bare-bones.tmpl")))
+                       (_ (write tar-name))
+                       (image-id (slurp ,(string-append #$docker-cli
+                                                        "/bin/docker")
+                                        "load" "-i" tar-name))
+                       (_ (write image-id)))
+                (system* ,(string-append #$docker-cli "/bin/docker")
+                         "run" "-e"
+                         "GUIX_NEW_SYSTEM=/var/guix/profiles/system"
+                         "--entrypoint"
+                         "/var/guix/profiles/system/profile/bin/guile"
+                         image-id
+                         "/var/guix/profiles/system/boot")))
+             marionette))
+
           (test-end)
           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 
@@ -95,5 +126,5 @@
 (define %test-docker
   (system-test
    (name "docker")
-   (description "Connect to the running Docker service.")
+   (description "Test the Docker service.")
    (value (run-docker-test))))