Skip to content
Snippets Groups Projects
Unverified Commit 4dd9664b authored by Mathieu Othacehe's avatar Mathieu Othacehe
Browse files

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.
parent 91204db3
No related branches found
No related tags found
No related merge requests found
......@@ -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)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment