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.
master
Ludovic Courtès 2017-09-07 23:31:21 +02:00
parent 505760ed08
commit 13877c3453
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 6 additions and 16 deletions

View File

@ -165,13 +165,14 @@ QEMU monitor and to the guest's backdoor REPL."
(newline repl) (newline repl)
(read repl)))) (read repl))))
(define* (wait-for-file file marionette #:key (timeout 10)) (define* (wait-for-file file marionette
"Wait until FILE exists in MARIONETTE; 'read' its content and return it. If #: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." FILE has not shown up after TIMEOUT seconds, raise an error."
(match (marionette-eval (match (marionette-eval
`(let loop ((i ,timeout)) `(let loop ((i ,timeout))
(cond ((file-exists? ,file) (cond ((file-exists? ,file)
(cons 'success (call-with-input-file ,file read))) (cons 'success (call-with-input-file ,file ,read)))
((> i 0) ((> i 0)
(sleep 1) (sleep 1)
(loop (- i 1))) (loop (- i 1)))

View File

@ -250,19 +250,8 @@ info --version")
;; It can take a while before the shell commands are executed. ;; It can take a while before the shell commands are executed.
(marionette-eval '(use-modules (rnrs io ports)) marionette) (marionette-eval '(use-modules (rnrs io ports)) marionette)
(marionette-eval (wait-for-file "/root/logged-in" marionette
'(let loop ((i 0)) #:read 'get-string-all)))
(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)))
;; There should be one utmpx entry for the user logged in on tty1. ;; There should be one utmpx entry for the user logged in on tty1.
(test-equal "utmpx entry" (test-equal "utmpx entry"