unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
To: 54368@debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Subject: [bug#54368] [PATCH 2/4] tests: install: Streamline 'qemu-command/writable-image'.
Date: Sun, 13 Mar 2022 00:43:53 -0500	[thread overview]
Message-ID: <20220313054356.17578-2-maxim.cournoyer@gmail.com> (raw)
In-Reply-To: <20220313054356.17578-1-maxim.cournoyer@gmail.com>

* gnu/tests/install.scm (qemu-command/writable-image): Replace the use of a
writable backing file by the use of the '-snapshot' option, and rename to...
(qemu-command*): ... this, adjusting all calls.
---
 gnu/tests/install.scm | 61 +++++++++++++++++--------------------------
 1 file changed, 24 insertions(+), 37 deletions(-)

diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index ae8c6051f1..d1f8cc1c6d 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -341,29 +341,16 @@ (define marionette
     (gexp->derivation "installation" install
                       #:substitutable? #f)))      ;too big
 
-(define* (qemu-command/writable-image image
-                                      #:key
-                                      (uefi-support? #f)
-                                      (memory-size 256))
-  "Return as a monadic value the command to run QEMU on a writable copy of
-IMAGE, a disk image.  The QEMU VM has access to MEMORY-SIZE MiB of RAM."
+(define* (qemu-command* image #:key (uefi-support? #f) (memory-size 256))
+  "Return as a monadic value the command to run QEMU with a writable overlay
+above IMAGE, a disk image.  The QEMU VM has access to MEMORY-SIZE MiB of RAM."
   (mlet* %store-monad ((system (current-system))
                        (uefi-firmware -> (and uefi-support?
                                               (uefi-firmware system))))
-    (return #~(let ((image #$image))
-                ;; First we need a writable copy of the image.
-                (format #t "creating writable image from '~a'...~%" image)
-                (unless (zero? (system* #+(file-append qemu-minimal
-                                                       "/bin/qemu-img")
-                                        "create" "-f" "qcow2" "-F" "qcow2"
-                                        "-o"
-                                        (string-append "backing_file=" image)
-                                        "disk.img"))
-                  (error "failed to create writable QEMU image" image))
-
-                (chmod "disk.img" #o644)
+    (return #~(begin
                 `(,(string-append #$qemu-minimal "/bin/"
                                   #$(qemu-command system))
+                  "-snapshot"           ;for the volatile, writable overlay
                   ,@(if (file-exists? "/dev/kvm")
                         '("-enable-kvm")
                         '())
@@ -371,7 +358,7 @@ (define* (qemu-command/writable-image image
                         '("-bios" #$uefi-firmware)
                         '())
                   "-no-reboot" "-m" #$(number->string memory-size)
-                  "-drive" "file=disk.img,if=virtio")))))
+                  "-drive" (format #f "file=~a,if=virtio" #$image))))))
 
 (define %test-installed-os
   (system-test
@@ -382,7 +369,7 @@ (define %test-installed-os
 build (current-guix) and then store a couple of full system images.")
    (value
     (mlet* %store-monad ((image   (run-install %minimal-os %minimal-os-source))
-                         (command (qemu-command/writable-image image)))
+                         (command (qemu-command* image)))
       (run-basic-test %minimal-os command
                       "installed-os")))))
 
@@ -399,7 +386,7 @@ (define %test-installed-extlinux-os
                                              (list syslinux)
                                              #:script
                                              %extlinux-gpt-installation-script))
-                         (command (qemu-command/writable-image image)))
+                         (command (qemu-command* image)))
       (run-basic-test %minimal-extlinux-os command
                       "installed-extlinux-os")))))
 
@@ -476,7 +463,7 @@ (define %test-iso-image-installer
                                    %simple-installation-script-for-/dev/vda
                                    #:installation-image-type
                                    'uncompressed-iso9660))
-                         (command (qemu-command/writable-image image)))
+                         (command (qemu-command* image)))
       (run-basic-test %minimal-os-on-vda command name)))))
 
 \f
@@ -531,7 +518,7 @@ (define %test-separate-home-os
                                                %separate-home-os-source
                                                #:script
                                                %simple-installation-script))
-                         (command (qemu-command/writable-image image)))
+                         (command (qemu-command* image)))
       (run-basic-test %separate-home-os command "separate-home-os")))))
 
 \f
@@ -608,7 +595,7 @@ (define %test-separate-store-os
                                                %separate-store-os-source
                                                #:script
                                                %separate-store-installation-script))
-                         (command (qemu-command/writable-image image)))
+                         (command (qemu-command* image)))
       (run-basic-test %separate-store-os command "separate-store-os")))))
 
 \f
@@ -690,7 +677,7 @@ (define %test-raid-root-os
                                                #:script
                                                %raid-root-installation-script
                                                #:target-size (* 3200 MiB)))
-                         (command (qemu-command/writable-image image)))
+                         (command (qemu-command* image)))
       (run-basic-test %raid-root-os
                       `(,@command) "raid-root-os")))))
 
@@ -823,7 +810,7 @@ (define %test-encrypted-root-os
                                                %encrypted-root-os-source
                                                #:script
                                                %encrypted-root-installation-script))
-                         (command (qemu-command/writable-image image)))
+                         (command (qemu-command* image)))
       (run-basic-test %encrypted-root-os command "encrypted-root-os"
                       #:initialization enter-luks-passphrase)))))
 
@@ -909,7 +896,7 @@ (define %test-lvm-separate-home-os
                                                %lvm-separate-home-installation-script
                                                #:packages (list lvm2-static)
                                                #:target-size (* 3200 MiB)))
-                         (command (qemu-command/writable-image image)))
+                         (command (qemu-command* image)))
       (run-basic-test %lvm-separate-home-os
                       `(,@command) "lvm-separate-home-os")))))
 
@@ -1009,7 +996,7 @@ (define %test-encrypted-root-not-boot-os
                              %encrypted-root-not-boot-os-source
                              #:script
                              %encrypted-root-not-boot-installation-script))
-         (command (qemu-command/writable-image image)))
+         (command (qemu-command* image)))
       (run-basic-test %encrypted-root-not-boot-os command
                       "encrypted-root-not-boot-os"
                       #:initialization enter-luks-passphrase)))))
@@ -1085,7 +1072,7 @@ (define %test-btrfs-root-os
                                                %btrfs-root-os-source
                                                #:script
                                                %btrfs-root-installation-script))
-                         (command (qemu-command/writable-image image)))
+                         (command (qemu-command* image)))
       (run-basic-test %btrfs-root-os command "btrfs-root-os")))))
 
 
@@ -1153,7 +1140,7 @@ (define %test-btrfs-raid-root-os
                              %btrfs-raid-root-os-source
                              #:script %btrfs-raid-root-installation-script
                              #:target-size (* 2800 MiB)))
-         (command (qemu-command/writable-image image)))
+         (command (qemu-command* image)))
       (run-basic-test %btrfs-raid-root-os `(,@command) "btrfs-raid-root-os")))))
 
 \f
@@ -1245,7 +1232,7 @@ (define %test-btrfs-root-on-subvolume-os
                        %btrfs-root-on-subvolume-os-source
                        #:script
                        %btrfs-root-on-subvolume-installation-script))
-         (command (qemu-command/writable-image image)))
+         (command (qemu-command* image)))
       (run-basic-test %btrfs-root-on-subvolume-os command
                       "btrfs-root-on-subvolume-os")))))
 
@@ -1319,7 +1306,7 @@ (define %test-jfs-root-os
                                                %jfs-root-os-source
                                                #:script
                                                %jfs-root-installation-script))
-                         (command (qemu-command/writable-image image)))
+                         (command (qemu-command* image)))
       (run-basic-test %jfs-root-os command "jfs-root-os")))))
 
 \f
@@ -1392,7 +1379,7 @@ (define %test-f2fs-root-os
                                                %f2fs-root-os-source
                                                #:script
                                                %f2fs-root-installation-script))
-                         (command (qemu-command/writable-image image)))
+                         (command (qemu-command* image)))
       (run-basic-test %f2fs-root-os command "f2fs-root-os")))))
 
 \f
@@ -1465,7 +1452,7 @@ (define %test-xfs-root-os
                                                %xfs-root-os-source
                                                #:script
                                                %xfs-root-installation-script))
-                         (command (qemu-command/writable-image image)))
+                         (command (qemu-command* image)))
       (run-basic-test %xfs-root-os command "xfs-root-os")))))
 
 \f
@@ -1748,9 +1735,9 @@ (define* (guided-installation-test name
                                   #:desktop? desktop?
                                   #:encrypted? encrypted?
                                   #:uefi-support? uefi-support?))))
-         (command (qemu-command/writable-image image
-                                               #:uefi-support? uefi-support?
-                                               #:memory-size 512)))
+         (command (qemu-command* image
+                                 #:uefi-support? uefi-support?
+                                 #:memory-size 512)))
       (run-basic-test target-os command name
                       #:initialization (and encrypted? enter-luks-passphrase)
                       #:root-password %root-password
-- 
2.34.0





  reply	other threads:[~2022-03-13  5:45 UTC|newest]

Thread overview: 11+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-03-13  5:40 [bug#54368] [PATCH 0/4] Add Btrfs RAID10 install tests Maxim Cournoyer
2022-03-13  5:43 ` [bug#54368] [PATCH 1/4] tests: install: Adjust the timeouts on two failing tests Maxim Cournoyer
2022-03-13  5:43   ` Maxim Cournoyer [this message]
2022-03-13  5:43   ` [bug#54368] [PATCH 3/4] tests: install: Enable the use of multiple disk devices for tests Maxim Cournoyer
2022-03-18  9:40     ` [bug#54368] [PATCH 0/4] Add Btrfs RAID10 install tests Mathieu Othacehe
2022-03-18 13:28       ` Maxim Cournoyer
2022-03-19 15:31       ` bug#54368: " Maxim Cournoyer
2022-03-18  9:41     ` [bug#54368] " Mathieu Othacehe
2022-03-18 13:31       ` Maxim Cournoyer
2022-03-18 15:26         ` Mathieu Othacehe
2022-03-13  5:43   ` [bug#54368] [PATCH 4/4] tests: install: Add two new Btrfs RAID10 install test Maxim Cournoyer

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20220313054356.17578-2-maxim.cournoyer@gmail.com \
    --to=maxim.cournoyer@gmail.com \
    --cc=54368@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).