mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
gnu: tests: reconfigure: Remove bootloader install test.
* gnu/tests/reconfigure.scm (%test-install-bootloader): Delete variable. (run-install-bootloader-test): Delete procedure. Change-Id: I3654d160f7306bb45a78b82ea6b249ff4281f739
This commit is contained in:
parent
9ba07f90f2
commit
545815bcbd
1 changed files with 1 additions and 85 deletions
|
@ -30,8 +30,7 @@ (define-module (gnu tests reconfigure)
|
||||||
#:use-module (guix scripts system reconfigure)
|
#:use-module (guix scripts system reconfigure)
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
#:export (%test-switch-to-system
|
#:export (%test-switch-to-system
|
||||||
%test-upgrade-services
|
%test-upgrade-services))
|
||||||
%test-install-bootloader))
|
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
;;;
|
;;;
|
||||||
|
@ -178,83 +177,6 @@ (define (running-services marionette)
|
||||||
(disable (upgrade-services-program '() '() '(dummy) '())))
|
(disable (upgrade-services-program '() '() '(dummy) '())))
|
||||||
(test enable disable))))
|
(test enable disable))))
|
||||||
|
|
||||||
(define* (run-install-bootloader-test)
|
|
||||||
"Run a test of an OS running INSTALL-BOOTLOADER-PROGRAM, which installs a
|
|
||||||
bootloader's configuration file."
|
|
||||||
(define os
|
|
||||||
(marionette-operating-system
|
|
||||||
(simple-operating-system)
|
|
||||||
#:imported-modules '((gnu services herd)
|
|
||||||
(guix combinators))))
|
|
||||||
|
|
||||||
(define vm (virtual-machine
|
|
||||||
(operating-system os)
|
|
||||||
(volatile? #f)))
|
|
||||||
|
|
||||||
(define (test script)
|
|
||||||
(with-imported-modules '((gnu build marionette))
|
|
||||||
#~(begin
|
|
||||||
(use-modules (gnu build marionette)
|
|
||||||
(ice-9 regex)
|
|
||||||
(srfi srfi-1)
|
|
||||||
(srfi srfi-64))
|
|
||||||
|
|
||||||
(define marionette
|
|
||||||
(make-marionette (list #$vm)))
|
|
||||||
|
|
||||||
;; Return the system generation paths that have GRUB menu entries.
|
|
||||||
(define (generations-in-grub-cfg marionette)
|
|
||||||
(let ((grub-cfg (marionette-eval
|
|
||||||
'(begin
|
|
||||||
(use-modules (rnrs io ports))
|
|
||||||
(call-with-input-file "/boot/grub/grub.cfg"
|
|
||||||
get-string-all))
|
|
||||||
marionette)))
|
|
||||||
(map (lambda (parameter)
|
|
||||||
(second (string-split (match:substring parameter) #\=)))
|
|
||||||
(list-matches "system=[^ ]*" grub-cfg))))
|
|
||||||
|
|
||||||
(test-runner-current (system-test-runner #$output))
|
|
||||||
(test-begin "install-bootloader")
|
|
||||||
|
|
||||||
(test-assert "no prior menu entry for system generation"
|
|
||||||
(not (member #$os (generations-in-grub-cfg marionette))))
|
|
||||||
|
|
||||||
(test-assert "script successfully evaluated"
|
|
||||||
(marionette-eval
|
|
||||||
'(primitive-load #$script)
|
|
||||||
marionette))
|
|
||||||
|
|
||||||
(test-assert "menu entry created for system generation"
|
|
||||||
(member #$os (generations-in-grub-cfg marionette)))
|
|
||||||
|
|
||||||
(test-end))))
|
|
||||||
|
|
||||||
(let* ((bootloader ((compose bootloader-configuration-bootloader
|
|
||||||
operating-system-bootloader)
|
|
||||||
os))
|
|
||||||
;; The typical use-case for 'install-bootloader-program' is to read
|
|
||||||
;; the boot parameters for the existing menu entries on the system,
|
|
||||||
;; parse them with 'boot-parameters->menu-entry', and pass the
|
|
||||||
;; results to 'operating-system-bootcfg'. However, to obtain boot
|
|
||||||
;; parameters, we would need to start the marionette, which we should
|
|
||||||
;; ideally avoid doing outside of the 'test' G-Expression. Thus, we
|
|
||||||
;; generate a bootloader configuration for the script as if there
|
|
||||||
;; were no existing menu entries. In the grand scheme of things, this
|
|
||||||
;; matters little -- these tests should not make assertions about the
|
|
||||||
;; behavior of 'operating-system-bootcfg'.
|
|
||||||
(bootcfg (operating-system-bootcfg os '()))
|
|
||||||
(bootcfg-file (bootloader-configuration-file bootloader)))
|
|
||||||
(gexp->derivation
|
|
||||||
"install-bootloader"
|
|
||||||
;; Due to the read-only nature of the virtual machines used in the system
|
|
||||||
;; test suite, the bootloader installer script is omitted. 'grub-install'
|
|
||||||
;; would attempt to write directly to the virtual disk if the
|
|
||||||
;; installation script were run.
|
|
||||||
(test
|
|
||||||
(install-bootloader-program #f #f #f bootcfg bootcfg-file '(#f) "/")))))
|
|
||||||
|
|
||||||
|
|
||||||
(define %test-switch-to-system
|
(define %test-switch-to-system
|
||||||
(system-test
|
(system-test
|
||||||
(name "switch-to-system")
|
(name "switch-to-system")
|
||||||
|
@ -267,9 +189,3 @@ (define %test-upgrade-services
|
||||||
(description "Upgrade the Shepherd by unloading obsolete services and
|
(description "Upgrade the Shepherd by unloading obsolete services and
|
||||||
loading new services.")
|
loading new services.")
|
||||||
(value (run-upgrade-services-test))))
|
(value (run-upgrade-services-test))))
|
||||||
|
|
||||||
(define %test-install-bootloader
|
|
||||||
(system-test
|
|
||||||
(name "install-bootloader")
|
|
||||||
(description "Install a bootloader and its configuration file.")
|
|
||||||
(value (run-install-bootloader-test))))
|
|
||||||
|
|
Loading…
Reference in a new issue