diff --git a/gnu/tests/reconfigure.scm b/gnu/tests/reconfigure.scm index bcc7645fa3..8aa5311171 100644 --- a/gnu/tests/reconfigure.scm +++ b/gnu/tests/reconfigure.scm @@ -30,8 +30,7 @@ (define-module (gnu tests reconfigure) #:use-module (guix scripts system reconfigure) #:use-module (guix store) #:export (%test-switch-to-system - %test-upgrade-services - %test-install-bootloader)) + %test-upgrade-services)) ;;; Commentary: ;;; @@ -178,83 +177,6 @@ (define (running-services marionette) (disable (upgrade-services-program '() '() '(dummy) '()))) (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 (system-test (name "switch-to-system") @@ -267,9 +189,3 @@ (define %test-upgrade-services (description "Upgrade the Shepherd by unloading obsolete services and loading new services.") (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))))