futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

services: hurd-vm: Resurrect system-test by using raw disk-image.

Browse Source 
Using the new compressed-qcow2 image breaks this test.

* gnu/tests/virtualization.scm (hurd-vm-disk-image-raw): New procedure.
(%childhurd-os): Use it.
This commit is contained in:
Jan (janneke) Nieuwenhuizen 2020-10-01 15:42:57 +02:00
parent e65991a363
commit 18e76f8905
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
1 changed files with 20 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
gnu/tests/virtualization.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net> ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,8 +20,11 @@
(define-module (gnu tests virtualization) (define-module (gnu tests virtualization)
#:use-module (gnu tests) #:use-module (gnu tests)
#:use-module (gnu image)
#:use-module (gnu system) #:use-module (gnu system)
#:use-module (gnu system file-systems) #: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 system vm)
#:use-module (gnu services) #:use-module (gnu services)
#:use-module (gnu services dbus) #:use-module (gnu services dbus)
@ -29,6 +33,7 @@
#:use-module (gnu packages virtualization) #:use-module (gnu packages virtualization)
#:use-module (gnu packages ssh) #:use-module (gnu packages ssh)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix records)
#:use-module (guix store) #:use-module (guix store)
#:export (%test-libvirt #:export (%test-libvirt
%test-childhurd)) %test-childhurd))
@ -107,10 +112,24 @@
;;; GNU/Hurd virtual machines, aka. childhurds. ;;; 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 (define %childhurd-os
(simple-operating-system (simple-operating-system
(service dhcp-client-service-type) (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 (run-childhurd-test)
(define os (define os