diff options
| author | Jan (janneke) Nieuwenhuizen <janneke@gnu.org> | 2020-10-01 15:42:57 +0200 |
|---|---|---|
| committer | Jan (janneke) Nieuwenhuizen <janneke@gnu.org> | 2020-10-01 15:47:29 +0200 |
| commit | 18e76f89055f25f015fadb7c999b410f38a88cc6 (patch) | |
| tree | 16efbcf771974f17cd0eca6357011912237d6218 /gnu/tests | |
| parent | e65991a36325d1ef34e32ff1ea741802e8664144 (diff) | |
| download | guix-18e76f89055f25f015fadb7c999b410f38a88cc6.tar.gz guix-18e76f89055f25f015fadb7c999b410f38a88cc6.zip | |
services: hurd-vm: Resurrect system-test by using raw disk-image.
Using the new compressed-qcow2 image breaks this test.
* gnu/tests/virtualization.scm (hurd-vm-disk-image-raw): New procedure.
(%childhurd-os): Use it.
Diffstat (limited to 'gnu/tests')
| -rw-r--r-- | gnu/tests/virtualization.scm | 21 |
1 files changed, 20 insertions, 1 deletions
diff --git a/gnu/tests/virtualization.scm b/gnu/tests/virtualization.scm index 9d381695be..e95787ee19 100644 --- a/gnu/tests/virtualization.scm +++ b/gnu/tests/virtualization.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,8 +20,11 @@ (define-module (gnu tests virtualization) #:use-module (gnu tests) + #:use-module (gnu image) #:use-module (gnu system) #:use-module (gnu system file-systems) + #:use-module (gnu system image) + #:use-module (gnu system images hurd) #:use-module (gnu system vm) #:use-module (gnu services) #:use-module (gnu services dbus) @@ -29,6 +33,7 @@ #:use-module (gnu packages virtualization) #:use-module (gnu packages ssh) #:use-module (guix gexp) + #:use-module (guix records) #:use-module (guix store) #:export (%test-libvirt %test-childhurd)) @@ -107,10 +112,24 @@ ;;; GNU/Hurd virtual machines, aka. childhurds. ;;; +;; Copy of `hurd-vm-disk-image', using plain disk-image for test +(define (hurd-vm-disk-image-raw config) + (let ((os ((@@ (gnu services virtualization) secret-service-operating-system) + (hurd-vm-configuration-os config))) + (disk-size (hurd-vm-configuration-disk-size config))) + (system-image + (image + (inherit hurd-disk-image) + (format 'disk-image) + (size disk-size) + (operating-system os))))) + (define %childhurd-os (simple-operating-system (service dhcp-client-service-type) - (service hurd-vm-service-type))) + (service hurd-vm-service-type + (hurd-vm-configuration + (image (hurd-vm-disk-image-raw this-record)))))) (define (run-childhurd-test) (define os |