summary refs log tree commit diff
path: root/gnu/tests/install.scm
diff options
context:
space:
mode:
authorMathieu Othacehe <m.othacehe@gmail.com>2020-03-22 10:52:43 +0100
committerMathieu Othacehe <m.othacehe@gmail.com>2020-03-22 10:53:55 +0100
commit1550db6fd47f84672b5bf554be922b96da2be3d8 (patch)
tree05d616d58529e8db96f553ca7c0837024cc13148 /gnu/tests/install.scm
parente64ea84392ca85d1ef23ebc5e4c1ec759f29b8cd (diff)
downloadguix-1550db6fd47f84672b5bf554be922b96da2be3d8.tar.gz
tests: install: Abort when one installation step fails.
When marionette-eval calls fail in gui-test-program, the installation
continues which results in two scenarios:

- hang forever at the next marionette-eval call,

- keep going and start a broken installation, which is annoying because it
clears the terminal and hides the error.

Make sure that gui-test-program is exited with #f return code when one of the
marionette-eval calls fail.

* gnu/tests/install.scm (gui-test-program): Add a new macro
"marionette-eval*". Throw an exception when one on the marionette-eval calls
fail.
Diffstat (limited to 'gnu/tests/install.scm')
-rw-r--r--gnu/tests/install.scm85
1 files changed, 45 insertions, 40 deletions
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 4f650ffb34..83988873c2 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.
 ;;;
@@ -946,67 +947,71 @@ build (current-guix) and then store a couple of full system images.")
         (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
+                                          #:desktop-environments '()
+                                          #: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))