branch master updated: Factorize build products creation.

[Mathieu Othacehe]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch master
in repository guix-cuirass.

The following commit(s) were added to refs/heads/master by this push:
     new 4dd9664  Factorize build products creation.
4dd9664 is described below

commit 4dd9664bf98b6063a1ea2d0f76fffd5414be456a
Author: Mathieu Othacehe <m.othacehe@gmail.com>
AuthorDate: Mon Jun 29 10:11:53 2020 +0200

    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.
---
 src/cuirass/base.scm | 21 +++++++++++++--------
 1 file changed, 13 insertions(+), 8 deletions(-)

diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 86e7da8..9d8706e 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -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)