branch master updated: Fix job insertion with existing outputs.

[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 1b35a77  Fix job insertion with existing outputs.
1b35a77 is described below

commit 1b35a7785627f3e8c5b6d8f37bf11eb4a470b4c4
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Wed Apr 7 15:04:23 2021 +0200

    Fix job insertion with existing outputs.
    
    Different derivations may result in a same build output. If a job registers 
a
    derivation D2 with the output O1, Cuirass may already have processed another
    derivation D1 with the same O1 output.
    
    In that case, the new job must point to the D1 derivation and not the D2
    derivation, for which no build will be triggered.
    
    * src/cuirass/database.scm (db-add-job): Fix it.
    * tests/database.scm ("db-register-builds same-outputs", "db-get-jobs
    same-outputs"): New tests.
---
 src/cuirass/database.scm | 21 ++++++++++++++++-----
 tests/database.scm       | 28 +++++++++++++++++++++++++---
 2 files changed, 41 insertions(+), 8 deletions(-)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index ef954f9..ec1e121 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -679,14 +679,25 @@ AND b2.status >= 0 ORDER BY b1.id,  b2.id DESC) d;"))
                (cons (string->number percentage) percentages)))))))
 
 (define (db-add-job job eval-id)
-  "Insert JOB into Jobs table for the EVAL-ID evaluation."
-  (let ((name       (assq-ref job #:job-name))
-        (derivation (assq-ref job #:derivation))
-        (system     (assq-ref job #:system)))
+  "Insert JOB into Jobs table for the EVAL-ID evaluation.  It is possible that
+another already built derivation has the same build outputs that the JOB
+derivation.  In that case, the JOB DERIVATION field is set to the existing
+derivation sharing the same build outputs, otherwise it is set to the given
+JOB derivation."
+  (let* ((name       (assq-ref job #:job-name))
+         (derivation (assq-ref job #:derivation))
+         (outputs    (assq-ref job #:outputs))
+         (output     (match outputs
+                       (((name . path) _ ...)
+                        path)))
+         (system     (assq-ref job #:system)))
+    (pk output derivation)
     (with-db-worker-thread db
       (exec-query/bind db "\
 INSERT INTO Jobs (name, evaluation, derivation, system)
-VALUES (" name ", " eval-id ", " derivation ", " system ")
+(SELECT " name ", " eval-id ",
+COALESCE((SELECT derivation FROM Outputs WHERE
+PATH = " output "), " derivation ")," system ")
 ON CONFLICT ON CONSTRAINT jobs_pkey DO NOTHING;"))))
 
 (define (db-get-jobs eval-id filters)
diff --git a/tests/database.scm b/tests/database.scm
index 07d1d00..ef1d691 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -213,6 +213,28 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 
0, 0);")
       ((job)
        (string=? (assq-ref job #:name) "test"))))
 
+  (test-assert "db-register-builds same-outputs"
+    (let ((drv "/test2.drv"))
+      (db-add-evaluation "guix"
+                         (make-dummy-instances "fakesha5" "fakesha6"))
+      (db-register-builds `(((#:job-name . "test")
+                             (#:derivation . ,drv)
+                             (#:system . "x86_64-linux")
+                             (#:nix-name . "test")
+                             (#:log . "log")
+                             (#:outputs .
+                              (("foo" . "/test.drv.output")
+                               ("foo2" . "/test.drv.output.2")))))
+                          4 (db-get-specification "guix"))))
+
+  (test-assert "db-get-jobs same-outputs"
+    (match (db-get-jobs 4 '())
+      ((job)
+       (string=? (assq-ref (pk (db-get-build
+                                (assq-ref job #:build)))
+                           #:derivation)
+                 "/test.drv"))))
+
   (test-assert "db-update-build-status!"
     (db-update-build-status! "/test.drv"
                              (build-status failed)))
@@ -280,9 +302,9 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 0, 
0);")
          (db-get-evaluations 2)))
 
   (test-equal "db-get-evaluations-build-summary"
-    '((0 0 0) (0 1 1))
+    '((0 0 0) (0 0 0) (0 1 1))
     (let ((summaries
-           (db-get-evaluations-build-summary "guix" 2 #f #f)))
+           (db-get-evaluations-build-summary "guix" 3 #f #f)))
       (map (lambda (summary)
              (list
               (assq-ref summary #:succeeded)
@@ -299,7 +321,7 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 0, 
0);")
     (db-get-evaluations-id-min "foo"))
 
   (test-equal "db-get-evaluations-id-max"
-    3
+    4
     (db-get-evaluations-id-max "guix"))
 
   (test-equal "db-get-evaluations-id-max"