From 40dd4196ba3d245c65e6cb900b8388e8f0387d72 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Fri, 1 May 2020 22:09:12 +0100
Subject: Fix the removal of missing input setup failures in the allocator

Previously it was ignoring all setup failures when a single one of the outputs
for a single setup failure should be available.
---
 guix-build-coordinator/build-allocator.scm | 107 ++++++++++++++++-------------
 1 file changed, 60 insertions(+), 47 deletions(-)

diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm
index 7e1b578..124cd9b 100644
--- a/guix-build-coordinator/build-allocator.scm
+++ b/guix-build-coordinator/build-allocator.scm
@@ -173,6 +173,26 @@
                         (cdr builds)
                         (cons build builds-to-defer)))))))
 
+    (define (treat-build-as-required build-id required-build-id priority)
+      (let ((required-build-derived-priority
+             (hash-ref derived-build-priorities-hash
+                       required-build-id)))
+        ;; Add an entry to the build-ordering-hints-hash to indicate that
+        ;; required-build-id should happen prior to build-id
+        (hash-set!
+         build-ordering-hints-hash
+         build-id
+         (cons required-build-id
+               (hash-ref build-ordering-hints-hash
+                         build-id
+                         '())))
+
+        (when (> priority required-build-derived-priority)
+          ;; Bump the priority of the build
+          (hash-set! derived-build-priorities-hash
+                     required-build-id
+                     priority))))
+
     ;; Go through the setup failures and look specifically at the
     ;; missing_inputs ones. Eliminate any missing_inputs failures if all the
     ;; missing inputs appear to have been built successfully, and update the
@@ -180,58 +200,51 @@
     ;; on the builds that would be "unblocked" if they were completed.
     (for-each
      (lambda (setup-failure-build-id)
-       (let ((setup-failures (hash-ref setup-failures-hash
-                                       setup-failure-build-id))
+       (let ((setup-failures
+              (filter
+               (lambda (setup-failure)
+                 (string=? "missing_inputs"
+                           (assq-ref setup-failure 'failure-reason)))
+               (hash-ref setup-failures-hash
+                         setup-failure-build-id)))
              (setup-failure-build-derived-priority
               (hash-ref derived-build-priorities-hash
                         setup-failure-build-id)))
          (for-each
           (lambda (setup-failure)
-            (when (string=? "missing_inputs"
-                            (assq-ref setup-failure 'failure-reason))
-              (for-each
-               (lambda (output)
-                 (let ((builds (cached/list-builds-for-output output)))
-                   (if (any (lambda (output-build)
-                              (string=? (or (assq-ref output-build 'result)
-                                            "unknown")
-                                        "success"))
-                            builds)
-                       ;; At least one build for this output has been successful,
-                       ;; so delete the setup failure
-                       (hash-remove! setup-failures-hash
-                                     setup-failure-build-id)
-                       ;; The missing input isn't available, so set the derived
-                       ;; priority to be as least as high as this build
-                       (for-each
-                        (lambda (build)
-                          (when (eq? 0 (assq-ref build 'processed))
-                            (let* ((missing-input-build-id
-                                    (assq-ref build 'uuid))
-                                   (missing-input-build-derived-priority
-                                    (hash-ref derived-build-priorities-hash
-                                              missing-input-build-id)))
-                              ;; Add an entry to the build-ordering-hints-hash
-                              ;; to indicate that missing-input-build-id
-                              ;; should happen prior to setup-failure-build-id
-                              (hash-set!
-                               build-ordering-hints-hash
-                               setup-failure-build-id
-                               (hash-ref build-ordering-hints-hash
-                                         setup-failure-build-id
-                                         '()))
-
-                              (when (> setup-failure-build-derived-priority
-                                       missing-input-build-derived-priority)
-                                ;; Bump the priority of the build
-                                (hash-set!
-                                 derived-build-priorities-hash
-                                 missing-input-build-id
-                                 setup-failure-build-derived-priority)))))
-                        builds))))
-               (datastore-list-setup-failure-missing-inputs
-                datastore
-                (assq-ref setup-failure 'id)))))
+            (let ((outputs-should-be-available
+                   (map
+                    (lambda (output)
+                      (let ((builds (cached/list-builds-for-output output)))
+                        (if (any (lambda (output-build)
+                                   (string=? (or (assq-ref output-build 'result)
+                                                 "unknown")
+                                             "success"))
+                                 builds)
+                            #t
+                            (begin
+                              (for-each
+                               (lambda (build)
+                                 (when (eq? 0 (assq-ref build 'processed))
+                                   (treat-build-as-required
+                                    setup-failure-build-id
+                                    (assq-ref build 'uuid)
+                                    setup-failure-build-derived-priority)))
+                               builds)
+                              #f))))
+                    (datastore-list-setup-failure-missing-inputs
+                     datastore
+                     (assq-ref setup-failure 'id)))))
+              (when (every (lambda (x) (eq? x #t))
+                           outputs-should-be-available)
+                ;; At least one build for each missing input has been
+                ;; successful, so delete the setup failure from the list of
+                ;; setup failures in the hash
+                (hash-set! setup-failures-hash
+                           setup-failure-build-id
+                           (delete setup-failure
+                                   (hash-ref setup-failures-hash
+                                             setup-failure-build-id))))))
           setup-failures)))
      (hash-map->list
       (lambda (key value) key)
-- 
cgit v1.2.3