03/06: marionette: 'wait-for-file' can be passed a read procedure.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 13877c34534fc6a1cda25a984007bc0e7d27ebc9
Author: Ludovic Courtès <address@hidden>
Date:   Thu Sep 7 23:31:21 2017 +0200

    marionette: 'wait-for-file' can be passed a read procedure.
    
    * gnu/build/marionette.scm (wait-for-file): Add #:read parameter and
    honor it.
    * gnu/tests/base.scm (run-basic-test)["login on tty1"]: Use
    'wait-for-file' instead of inline code.
---
 gnu/build/marionette.scm |  7 ++++---
 gnu/tests/base.scm       | 15 ++-------------
 2 files changed, 6 insertions(+), 16 deletions(-)

diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm
index f35f0fb..7554a71 100644
--- a/gnu/build/marionette.scm
+++ b/gnu/build/marionette.scm
@@ -165,13 +165,14 @@ QEMU monitor and to the guest's backdoor REPL."
      (newline repl)
      (read repl))))
 
-(define* (wait-for-file file marionette #:key (timeout 10))
-  "Wait until FILE exists in MARIONETTE; 'read' its content and return it.  If
+(define* (wait-for-file file marionette
+                        #:key (timeout 10) (read 'read))
+  "Wait until FILE exists in MARIONETTE; READ its content and return it.  If
 FILE has not shown up after TIMEOUT seconds, raise an error."
   (match (marionette-eval
           `(let loop ((i ,timeout))
              (cond ((file-exists? ,file)
-                    (cons 'success (call-with-input-file ,file read)))
+                    (cons 'success (call-with-input-file ,file ,read)))
                    ((> i 0)
                     (sleep 1)
                     (loop (- i 1)))
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 5b40d45..959da31 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -250,19 +250,8 @@ info --version")
 
               ;; It can take a while before the shell commands are executed.
               (marionette-eval '(use-modules (rnrs io ports)) marionette)
-              (marionette-eval
-               '(let loop ((i 0))
-                  (catch 'system-error
-                    (lambda ()
-                      (call-with-input-file "/root/logged-in"
-                        get-string-all))
-                    (lambda args
-                      (if (and (< i 15) (= ENOENT (system-error-errno args)))
-                          (begin
-                            (sleep 1)
-                            (loop (+ i 1)))
-                          (apply throw args)))))
-               marionette)))
+              (wait-for-file "/root/logged-in" marionette
+                             #:read 'get-string-all)))
 
           ;; There should be one utmpx entry for the user logged in on tty1.
           (test-equal "utmpx entry"