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

hydra: 'evaluate' now validates job alists.

Browse source 
* build-aux/hydra/evaluate.scm (assert-valid-job): New procedure.
<top level>: Use it.
This commit is contained in:
Ludovic Courtès 2016-06-21 15:50:51 +02:00
parent 9270298f75
commit 4c9243b688
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 14 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
build-aux/hydra/evaluate.scm
View file

@ -49,6 +49,17 @@ (define (call-with-time-display thunk)
(/ (time-nanosecond time) 1e9))) (/ (time-nanosecond time) 1e9)))
(apply values results)))) (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... ;; Without further ado...
(match (command-line) (match (command-line)
@ -83,7 +94,9 @@ (define (call-with-time-display thunk)
(map (lambda (job thunk) (map (lambda (job thunk)
(format (current-error-port) "evaluating '~a'... " job) (format (current-error-port) "evaluating '~a'... " job)
(force-output (current-error-port)) (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))) names thunks)))
port)))) port))))
((command _ ...) ((command _ ...)