guix
/
guix-cuirass
mirror of git://git.savannah.gnu.org/guix/guix-cuirass.git
2
0
Fork 0
Code Issues Releases Wiki Activity

Factorize build products creation. 

Make sure that build products are also created when a batch of derivations
finishes, and not only when single build success events are received.

Factorize build status update to success and build products creation into a
single procedure.

* src/cuirass/base.scm (set-build-successful!): New procedure,
(update-build-statuses!): call it here,
(handle-build-event): and here.
This commit is contained in:
Mathieu Othacehe 2020-06-29 10:11:53 +02:00
parent 91204db33a
commit 4dd9664bf9
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
1 changed files with 13 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/cuirass/base.scm
View File

@ -449,7 +449,16 @@ Essentially this procedure inverts the inversion-of-control that
;; Our shuffling algorithm is simple: we sort by .drv file name. :-)
(sort drv string<?))
(define (update-build-statuses! store lst)
(define (set-build-successful! spec drv)
"Update the build status of DRV as successful and register any eventual
build products according to SPEC."
(let ((build (db-get-build drv)))
(when (and spec build)
(create-build-outputs build
(assq-ref spec #:build-outputs))))
(db-update-build-status! drv (build-status succeeded)))
(define (update-build-statuses! store spec lst)
"Update the build status of the derivations listed in LST, which have just
been passed to 'build-derivations' (meaning that we can assume that, if their
outputs are invalid, that they failed to build.)"
@ -457,7 +466,7 @@ outputs are invalid, that they failed to build.)"
(match (derivation-path->output-paths drv)
(((_ . outputs) ...)
(if (any (cut valid-path? store <>) outputs)
(db-update-build-status! drv (build-status succeeded))
(set-build-successful! spec drv)
(db-update-build-status! drv
(if (log-file store drv)
(build-status failed)
@ -543,7 +552,7 @@ items."
;; 'build-derivations' doesn't actually do anything and
;; 'handle-build-event' doesn't see any event. Because of that,
;; adjust the database here.
(update-build-statuses! store batch)
(update-build-statuses! store spec batch)
(loop rest (max (- count max-batch-size) 0))))))
@ -577,11 +586,7 @@ updating the database accordingly."
(if (valid? drv)
(begin
(log-message "build succeeded: '~a'" drv)
(let ((build (db-get-build drv)))
(when (and spec build)
(create-build-outputs build
(assq-ref spec #:build-outputs))))
(db-update-build-status! drv (build-status succeeded))
(set-build-successful! spec drv)
(for-each (match-lambda
((name . output)