tests: install: Add %test-gui-installed-desktop-os-encrypted.

* gnu/tests/install.scm (gui-test-program): Add a desktop? argument, and pass it to choose-services,
(installation-target-os-for-gui-tests): new procedure,
(installation-target-desktop-os-for-gui-tests): new procedure,
(guided-installation-test): add target-os and desktop? arguments. Use
target-os instead of the previous os variable. Pass desktop? argument to
gui-test-program.
(%test-gui-installed-os): Adapt accordingly,
(%test-gui-installed-os-encrypted): ditto,
(%test-gui-installed-desktop-os-encrypted): new exported variable.

1 files changed, 113 insertions, 41 deletions

diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 83988873c2..b0b40f2764 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -32,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
@@ -52,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:
 ;;;
@@ -203,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
@@ -220,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
@@ -941,7 +951,10 @@ 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)
@@ -998,7 +1011,8 @@ build (current-guix) and then store a couple of full system images.")
       (screenshot "installer-services.ppm")
 
       (marionette-eval* '(choose-services installer-socket
-                                          #:desktop-environments '()
+                                          #:choose-desktop-environment?
+                                          (const #$desktop?)
                                           #:choose-network-service?
                                           (const #f))
                         #$marionette)
@@ -1038,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