ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-12 06:06:53 -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) (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)))

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. ;; 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"