ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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.
This commit is contained in:
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
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gnu/build/marionette.scm
View file

@ -165,13 +165,14 @@ (define (marionette-eval exp marionette)
(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)))

15
gnu/tests/base.scm
View file

@ -250,19 +250,8 @@ (define (user-owned? file)
;; 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"