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
next prev parent 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
* 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 external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.