diff options
author | Marius Bakke <mbakke@fastmail.com> | 2020-03-27 00:12:15 +0100 |
---|---|---|
committer | Marius Bakke <mbakke@fastmail.com> | 2020-03-27 00:12:15 +0100 |
commit | 18af6870370226b4d502d7372844e7f2aded5887 (patch) | |
tree | 749d93209bd0cb9710ccaae2207df670f37eaa36 /gnu/tests | |
parent | 0ab8ad46322bea331ed5f5592843ba35e7f38b37 (diff) | |
parent | 3089b70d766bd9ec70e1464867130b7b864fbe17 (diff) | |
download | guix-18af6870370226b4d502d7372844e7f2aded5887.tar.gz |
Merge branch 'master' into core-updates
Conflicts: gnu/packages/icu4c.scm gnu/packages/man.scm gnu/packages/python-xyz.scm guix/scripts/environment.scm guix/scripts/pack.scm guix/scripts/package.scm guix/scripts/pull.scm guix/store.scm
Diffstat (limited to 'gnu/tests')
-rw-r--r-- | gnu/tests/install.scm | 237 | ||||
-rw-r--r-- | gnu/tests/linux-modules.scm | 103 | ||||
-rw-r--r-- | gnu/tests/nfs.scm | 2 |
3 files changed, 261 insertions, 81 deletions
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm index 4f650ffb34..b0b40f2764 100644 --- a/gnu/tests/install.scm +++ b/gnu/tests/install.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017, 2019 Tobias Geerinckx-Rice <me@tobias.gr> +;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -31,15 +32,23 @@ #:use-module (gnu packages cryptsetup) #:use-module (gnu packages linux) #:use-module (gnu packages ocr) + #:use-module (gnu packages openbox) #:use-module (gnu packages package-management) + #:use-module (gnu packages ratpoison) + #:use-module (gnu packages suckless) #:use-module (gnu packages virtualization) + #:use-module (gnu packages wm) + #:use-module (gnu packages xorg) + #:use-module (gnu services desktop) #:use-module (gnu services networking) + #:use-module (gnu services xorg) #:use-module (guix store) #:use-module (guix monads) #:use-module (guix packages) #:use-module (guix grafts) #:use-module (guix gexp) #:use-module (guix utils) + #:use-module (srfi srfi-1) #:export (%test-installed-os %test-installed-extlinux-os %test-iso-image-installer @@ -51,7 +60,8 @@ %test-jfs-root-os %test-gui-installed-os - %test-gui-installed-os-encrypted)) + %test-gui-installed-os-encrypted + %test-gui-installed-desktop-os-encrypted)) ;;; Commentary: ;;; @@ -202,6 +212,7 @@ reboot\n") (gnu installer tests) (guix combinators)))) (installation-disk-image-file-system-type "ext4") + (install-size 'guess) (target-size (* 2200 MiB))) "Run SCRIPT (a shell script following the system installation procedure) in OS to install TARGET-OS. Return a VM image of TARGET-SIZE bytes containing @@ -219,7 +230,7 @@ packages defined in installation-os." (image (system-disk-image (operating-system-with-gc-roots os (list target)) - #:disk-image-size 'guess + #:disk-image-size install-size #:file-system-type installation-disk-image-file-system-type))) (define install @@ -940,73 +951,81 @@ build (current-guix) and then store a couple of full system images.") (define %root-password "foo") -(define* (gui-test-program marionette #:key (encrypted? #f)) +(define* (gui-test-program marionette + #:key + (desktop? #f) + (encrypted? #f)) #~(let () (define (screenshot file) (marionette-control (string-append "screendump " file) #$marionette)) + (define-syntax-rule (marionette-eval* exp marionette) + (or (marionette-eval exp marionette) + (throw 'marionette-eval-failure 'exp))) + (setvbuf (current-output-port) 'none) (setvbuf (current-error-port) 'none) - (marionette-eval '(use-modules (gnu installer tests)) - #$marionette) + (marionette-eval* '(use-modules (gnu installer tests)) + #$marionette) ;; Arrange so that 'converse' prints debugging output to the console. - (marionette-eval '(let ((console (open-output-file "/dev/console"))) - (setvbuf console 'none) - (conversation-log-port console)) - #$marionette) + (marionette-eval* '(let ((console (open-output-file "/dev/console"))) + (setvbuf console 'none) + (conversation-log-port console)) + #$marionette) ;; Tell the installer to not wait for the Connman "online" status. - (marionette-eval '(call-with-output-file "/tmp/installer-assume-online" - (const #t)) - #$marionette) + (marionette-eval* '(call-with-output-file "/tmp/installer-assume-online" + (const #t)) + #$marionette) ;; Run 'guix system init' with '--no-grafts', to cope with the lack of ;; network access. - (marionette-eval '(call-with-output-file - "/tmp/installer-system-init-options" - (lambda (port) - (write '("--no-grafts" "--no-substitutes") - port))) - #$marionette) - - (marionette-eval '(define installer-socket - (open-installer-socket)) - #$marionette) + (marionette-eval* '(call-with-output-file + "/tmp/installer-system-init-options" + (lambda (port) + (write '("--no-grafts" "--no-substitutes") + port))) + #$marionette) + + (marionette-eval* '(define installer-socket + (open-installer-socket)) + #$marionette) (screenshot "installer-start.ppm") - (marionette-eval '(choose-locale+keyboard installer-socket) - #$marionette) + (marionette-eval* '(choose-locale+keyboard installer-socket) + #$marionette) (screenshot "installer-locale.ppm") ;; Choose the host name that the "basic" test expects. - (marionette-eval '(enter-host-name+passwords installer-socket - #:host-name "liberigilo" - #:root-password - #$%root-password - #:users - '(("alice" "pass1") - ("bob" "pass2"))) - #$marionette) + (marionette-eval* '(enter-host-name+passwords installer-socket + #:host-name "liberigilo" + #:root-password + #$%root-password + #:users + '(("alice" "pass1") + ("bob" "pass2"))) + #$marionette) (screenshot "installer-services.ppm") - (marionette-eval '(choose-services installer-socket - #:desktop-environments '() - #:choose-network-service? - (const #f)) - #$marionette) + (marionette-eval* '(choose-services installer-socket + #:choose-desktop-environment? + (const #$desktop?) + #:choose-network-service? + (const #f)) + #$marionette) (screenshot "installer-partitioning.ppm") - (marionette-eval '(choose-partitioning installer-socket - #:encrypted? #$encrypted? - #:passphrase #$%luks-passphrase) - #$marionette) + (marionette-eval* '(choose-partitioning installer-socket + #:encrypted? #$encrypted? + #:passphrase #$%luks-passphrase) + #$marionette) (screenshot "installer-run.ppm") - (marionette-eval '(conclude-installation installer-socket) - #$marionette) + (marionette-eval* '(conclude-installation installer-socket) + #$marionette) (sync) #t)) @@ -1033,53 +1052,111 @@ build (current-guix) and then store a couple of full system images.") (gnu installer tests) (guix combinators)))) -(define* (guided-installation-test name #:key encrypted?) - (define os - (operating-system - (inherit %minimal-os) - (users (append (list (user-account - (name "alice") - (comment "Bob's sister") - (group "users") - (supplementary-groups - '("wheel" "audio" "video"))) - (user-account - (name "bob") - (comment "Alice's brother") - (group "users") - (supplementary-groups - '("wheel" "audio" "video")))) - %base-user-accounts)) - ;; The installer does not create a swap device in guided mode with - ;; encryption support. - (swap-devices (if encrypted? '() '("/dev/vdb2"))) - (services (cons (service dhcp-client-service-type) - (operating-system-user-services %minimal-os))))) - +(define* (installation-target-os-for-gui-tests + #:key (encrypted? #f)) + (operating-system + (inherit %minimal-os) + (users (append (list (user-account + (name "alice") + (comment "Bob's sister") + (group "users") + (supplementary-groups + '("wheel" "audio" "video"))) + (user-account + (name "bob") + (comment "Alice's brother") + (group "users") + (supplementary-groups + '("wheel" "audio" "video")))) + %base-user-accounts)) + ;; The installer does not create a swap device in guided mode with + ;; encryption support. + (swap-devices (if encrypted? '() '("/dev/vdb2"))) + (services (cons (service dhcp-client-service-type) + (operating-system-user-services %minimal-os))))) + +(define* (installation-target-desktop-os-for-gui-tests + #:key (encrypted? #f)) + (operating-system + (inherit (installation-target-os-for-gui-tests + #:encrypted? encrypted?)) + (keyboard-layout (keyboard-layout "us" "altgr-intl")) + + ;; Make sure that all the packages and services that may be used by the + ;; graphical installer are available. + (packages (append + (list openbox awesome i3-wm i3status + dmenu st ratpoison xterm) + %base-packages)) + (services + (append + (list (service gnome-desktop-service-type) + (service xfce-desktop-service-type) + (service mate-desktop-service-type) + (service enlightenment-desktop-service-type) + (set-xorg-configuration + (xorg-configuration + (keyboard-layout keyboard-layout))) + (service marionette-service-type + (marionette-configuration + (imported-modules '((gnu services herd) + (guix build utils) + (guix combinators)))))) + %desktop-services)))) + +(define* (guided-installation-test name + #:key + (desktop? #f) + (encrypted? #f) + target-os + (install-size 'guess) + (target-size (* 2200 MiB))) (system-test (name name) (description "Install an OS using the graphical installer and test it.") (value - (mlet* %store-monad ((image (run-install os '(this is unused) - #:script #f - #:os installation-os-for-gui-tests - #:gui-test - (lambda (marionette) - (gui-test-program - marionette - #:encrypted? encrypted?)))) - (command (qemu-command/writable-image image))) - (run-basic-test os command name + (mlet* %store-monad + ((image (run-install target-os '(this is unused) + #:script #f + #:os installation-os-for-gui-tests + #:install-size install-size + #:target-size target-size + #:gui-test + (lambda (marionette) + (gui-test-program + marionette + #:desktop? desktop? + #:encrypted? encrypted?)))) + (command (qemu-command/writable-image image))) + (run-basic-test target-os command name #:initialization (and encrypted? enter-luks-passphrase) #:root-password %root-password))))) (define %test-gui-installed-os - (guided-installation-test "gui-installed-os" - #:encrypted? #f)) + (guided-installation-test + "gui-installed-os" + #:target-os (installation-target-os-for-gui-tests))) (define %test-gui-installed-os-encrypted - (guided-installation-test "gui-installed-os-encrypted" - #:encrypted? #t)) + (guided-installation-test + "gui-installed-os-encrypted" + #:encrypted? #t + #:target-os (installation-target-os-for-gui-tests + #:encrypted? #t))) + +;; Building a desktop image is very time and space consuming. Install all +;; desktop environments in a single test to reduce the overhead. +(define %test-gui-installed-desktop-os-encrypted + (guided-installation-test "gui-installed-desktop-os-encrypted" + #:desktop? #t + #:encrypted? #t + #:target-os + (installation-target-desktop-os-for-gui-tests + #:encrypted? #t) + ;; XXX: The disk-image size guess is too low. Use + ;; a constant value until this is fixed. + #:install-size (* 8000 MiB) + #:target-size (* 9000 MiB))) ;;; install.scm ends here diff --git a/gnu/tests/linux-modules.scm b/gnu/tests/linux-modules.scm new file mode 100644 index 0000000000..39e11587c6 --- /dev/null +++ b/gnu/tests/linux-modules.scm @@ -0,0 +1,103 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org> +;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (gnu tests linux-modules) + #:use-module (gnu packages linux) + #:use-module (gnu system) + #:use-module (gnu system vm) + #:use-module (gnu tests) + #:use-module (guix derivations) + #:use-module (guix gexp) + #:use-module (guix modules) + #:use-module (guix monads) + #:use-module (guix store) + #:export (%test-loadable-kernel-modules-0 + %test-loadable-kernel-modules-1 + %test-loadable-kernel-modules-2)) + +;;; Commentary: +;;; +;;; Test <operating-system> kernel-loadable-modules. +;;; +;;; Code: + +(define* (module-loader-program os modules) + "Return an executable store item that, upon being evaluated, will dry-run +load MODULES." + (program-file + "load-kernel-modules.scm" + (with-imported-modules (source-module-closure '((guix build utils))) + #~(begin + (use-modules (guix build utils)) + (for-each (lambda (module) + (invoke (string-append #$kmod "/bin/modprobe") "-n" "--" + module)) + '#$modules))))) + +(define* (run-loadable-kernel-modules-test module-packages module-names) + "Run a test of an OS having MODULE-PACKAGES, and modprobe MODULE-NAMES." + (define os + (marionette-operating-system + (operating-system + (inherit (simple-operating-system)) + (kernel-loadable-modules module-packages)) + #:imported-modules '((guix combinators)))) + (define vm (virtual-machine os)) + (define (test script) + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (gnu build marionette) + (srfi srfi-64)) + (define marionette + (make-marionette (list #$vm))) + (mkdir #$output) + (chdir #$output) + (test-begin "loadable-kernel-modules") + (test-assert "script successfully evaluated" + (marionette-eval + '(primitive-load #$script) + marionette)) + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + (gexp->derivation "loadable-kernel-modules" (test (module-loader-program os module-names)))) + +(define %test-loadable-kernel-modules-0 + (system-test + (name "loadable-kernel-modules-0") + (description "Tests loadable kernel modules facility of <operating-system> +with no extra modules.") + (value (run-loadable-kernel-modules-test '() '())))) + +(define %test-loadable-kernel-modules-1 + (system-test + (name "loadable-kernel-modules-1") + (description "Tests loadable kernel modules facility of <operating-system> +with one extra module.") + (value (run-loadable-kernel-modules-test + (list ddcci-driver-linux) + '("ddcci"))))) + +(define %test-loadable-kernel-modules-2 + (system-test + (name "loadable-kernel-modules-2") + (description "Tests loadable kernel modules facility of <operating-system> +with two extra modules.") + (value (run-loadable-kernel-modules-test + (list acpi-call-linux-module ddcci-driver-linux) + '("acpi_call" "ddcci"))))) diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm index 00109b752e..5e4de2783b 100644 --- a/gnu/tests/nfs.scm +++ b/gnu/tests/nfs.scm @@ -236,7 +236,7 @@ (use-modules (gnu services herd)) (start-service 'nfs)) marionette) - (wait-for-file "/var/run/rpc.statd.pid"))) + (wait-for-file "/var/run/rpc.statd.pid" marionette))) (test-assert "nfs share is advertised" (marionette-eval |