summary refs log tree commit diff
path: root/gnu/tests
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2020-03-27 00:12:15 +0100
committerMarius Bakke <mbakke@fastmail.com>2020-03-27 00:12:15 +0100
commit18af6870370226b4d502d7372844e7f2aded5887 (patch)
tree749d93209bd0cb9710ccaae2207df670f37eaa36 /gnu/tests
parent0ab8ad46322bea331ed5f5592843ba35e7f38b37 (diff)
parent3089b70d766bd9ec70e1464867130b7b864fbe17 (diff)
downloadguix-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.scm237
-rw-r--r--gnu/tests/linux-modules.scm103
-rw-r--r--gnu/tests/nfs.scm2
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