mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
hydra: 'evaluate' now validates job alists.
* build-aux/hydra/evaluate.scm (assert-valid-job): New procedure. <top level>: Use it.
This commit is contained in:
parent
9270298f75
commit
4c9243b688
1 changed files with 14 additions and 1 deletions
|
@ -49,6 +49,17 @@ (define (call-with-time-display thunk)
|
|||
(/ (time-nanosecond time) 1e9)))
|
||||
(apply values results))))
|
||||
|
||||
(define (assert-valid-job job thing)
|
||||
"Raise an error if THING is not an alist with a valid 'derivation' entry.
|
||||
Otherwise return THING."
|
||||
(unless (and (list? thing)
|
||||
(and=> (assoc-ref thing 'derivation)
|
||||
(lambda (value)
|
||||
(and (string? value)
|
||||
(string-suffix? ".drv" value)))))
|
||||
(error "job did not produce a valid alist" job thing))
|
||||
thing)
|
||||
|
||||
|
||||
;; Without further ado...
|
||||
(match (command-line)
|
||||
|
@ -83,7 +94,9 @@ (define (call-with-time-display thunk)
|
|||
(map (lambda (job thunk)
|
||||
(format (current-error-port) "evaluating '~a'... " job)
|
||||
(force-output (current-error-port))
|
||||
(cons job (call-with-time-display thunk)))
|
||||
(cons job
|
||||
(assert-valid-job job
|
||||
(call-with-time-display thunk))))
|
||||
names thunks)))
|
||||
port))))
|
||||
((command _ ...)
|
||||
|
|
Loading…
Reference in a new issue