GNU bug report logs - #34039
[WIP] tests: Make docker system test more comprehensive.

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 34039 in the body.
You can then email your comments to 34039 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Danny Milosavljevic <dannym <at> scratchpost.org>
To: guix-patches <at> gnu.org
Cc: Danny Milosavljevic <dannym <at> scratchpost.org>
Subject: [WIP] tests: Make docker system test more comprehensive.
Date: Thu, 10 Jan 2019 22:58:32 +0100

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 <at> scratchpost.org>
 ;;; Copyright © 2017 Christopher Baines <mail <at> 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))))

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.