guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[no subject]


From: Mathieu Othacehe
Date: Mon, 4 Oct 2021 06:59:15 -0400 (EDT)

branch: master
commit b726b017f06b03106753120bd1f1d69559a357a7
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Mon Oct 4 10:47:39 2021 +0000

    Improve pending build selection perfomances.
    
    * src/sql/upgrade-13.sql: New file.
    * Makefile.am (dist_sql_DATA): Add it.
    * src/schema.sql (pending_dependencies): Remove it.
    * src/cuirass/database.scm (db-get-pending-build): New procedure.
    (db-get-builds): Remove "no-dependencies" support.
    * src/cuirass/scripts/remote-server.scm (pop-build): Adapt to use the new
    procedure.
    * tests/database.scm: Adapt it.
---
 Makefile.am                           |  3 ++-
 src/cuirass/database.scm              | 20 ++++++++++++++++++--
 src/cuirass/scripts/remote-server.scm |  8 +-------
 src/schema.sql                        |  7 -------
 src/sql/upgrade-13.sql                |  5 +++++
 tests/database.scm                    | 19 ++++---------------
 6 files changed, 30 insertions(+), 32 deletions(-)

diff --git a/Makefile.am b/Makefile.am
index 6cfa3d7..68cedbc 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -100,7 +100,8 @@ dist_sql_DATA =                             \
   src/sql/upgrade-9.sql                                \
   src/sql/upgrade-10.sql                       \
   src/sql/upgrade-11.sql                       \
-  src/sql/upgrade-12.sql
+  src/sql/upgrade-12.sql                       \
+  src/sql/upgrade-13.sql
 
 dist_css_DATA =                                        \
   src/static/css/choices.min.css               \
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 9042544..7e036b3 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -90,6 +90,7 @@
             db-get-events
             db-delete-events-with-ids-<=-to
             db-get-pending-derivations
+            db-get-pending-build
             db-get-checkouts
             db-get-latest-checkout
             db-get-evaluation
@@ -1181,7 +1182,6 @@ CASE WHEN CAST(:borderlowid AS integer) IS NULL THEN
         (worker          . "Builds.worker = :worker")
         (oldevaluation   . "Builds.evaluation < :oldevaluation")
         (evaluation      . "Builds.evaluation = :evaluation")
-        (no-dependencies . "PD.deps = 0")
         (status          . ,(match (assq-ref filters 'status)
                               (#f         #f)
                               ('done      "Builds.status >= 0")
@@ -1272,7 +1272,6 @@ build_dependencies(B.id) AS bd_target FROM
 (SELECT Builds.id, Builds.derivation, Specifications.name FROM Builds
 INNER JOIN Evaluations ON Builds.evaluation = Evaluations.id
 INNER JOIN Specifications ON Evaluations.specification = Specifications.name
-LEFT JOIN pending_dependencies as PD on PD.id = Builds.id
 ~a
 ORDER BY ~a
 LIMIT :nr) B
@@ -1363,6 +1362,23 @@ the database.  The returned list is guaranteed to not 
have any duplicates."
          (exec-query db "
 SELECT derivation FROM Builds WHERE Builds.status < 0;"))))
 
+(define (db-get-pending-build system)
+  "Return the pending build with no dependencies for SYSTEM that has the
+lowest priority and the highest timestamp."
+  (with-db-worker-thread db
+    (match (expect-one-row
+            (exec-query/bind db "
+WITH pending_dependencies AS
+(SELECT Builds.id, count(dep.id) as deps FROM Builds
+LEFT JOIN BuildDependencies as bd ON bd.source = Builds.id
+LEFT JOIN Builds AS dep ON bd.target = dep.id AND dep.status != 0
+WHERE Builds.status = -2 AND Builds.system = " system
+" GROUP BY Builds.id
+ORDER BY Builds.priority ASC, Builds.timestamp DESC)
+SELECT id FROM pending_dependencies WHERE deps = 0 LIMIT 1;"))
+      ((id) (db-get-build (string->number id)))
+      (else #f))))
+
 (define (db-get-checkouts eval-id)
   (with-db-worker-thread db
     (let loop ((rows (exec-query/bind
diff --git a/src/cuirass/scripts/remote-server.scm 
b/src/cuirass/scripts/remote-server.scm
index f15ec7c..96e9632 100644
--- a/src/cuirass/scripts/remote-server.scm
+++ b/src/cuirass/scripts/remote-server.scm
@@ -223,13 +223,7 @@ and store the result inside the BOX."
     (and worker
          (let ((system (random-system
                         (worker-systems worker))))
-           (match (db-get-builds `((status . scheduled)
-                                   (system . ,system)
-                                   (order . priority+timestamp)
-                                   (no-dependencies . #t)
-                                   (nr . 1)))
-             ((build) build)
-             (() #f))))))
+           (db-get-pending-build system)))))
 
 (define* (read-worker-exp msg #:key reply-worker)
   "Read the given MSG sent by a worker.  REPLY-WORKER is a procedure that can
diff --git a/src/schema.sql b/src/schema.sql
index ec5b6af..cd9c512 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -148,13 +148,6 @@ FROM BuildDependencies as BD
 WHERE BD.source = $1
 $$ LANGUAGE sql;
 
--- Return the count of pending dependencies for all the scheduled builds.
-CREATE VIEW pending_dependencies AS
-SELECT Builds.id, count(dep.id) as deps FROM Builds
-LEFT JOIN BuildDependencies as bd ON bd.source = Builds.id
-LEFT JOIN Builds AS dep ON bd.target = dep.id AND dep.status != 0
-WHERE Builds.status = -2 GROUP BY Builds.id;
-
 -- XXX: All queries targeting Builds and Outputs tables *must* be covered by
 -- an index.  It is also preferable for the other tables.
 CREATE INDEX Builds_status_index ON Builds (status);
diff --git a/src/sql/upgrade-13.sql b/src/sql/upgrade-13.sql
new file mode 100644
index 0000000..4441fd0
--- /dev/null
+++ b/src/sql/upgrade-13.sql
@@ -0,0 +1,5 @@
+BEGIN TRANSACTION;
+
+DROP VIEW pending_dependencies;
+
+COMMIT;
diff --git a/tests/database.scm b/tests/database.scm
index 53a7aac..06c8e63 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -709,24 +709,13 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 
0, 0);")
 
   (test-assert "db-get-builds no-dependencies"
     (begin
-      (db-update-build-status! "/build-2.drv"
-                               (build-status scheduled))
-      (let ((builds
-             (map (cut assq-ref <> #:derivation)
-                  (db-get-builds `((no-dependencies . #t))))))
-        (and (member "/build-2.drv" builds)
-             (not (member "/build-1.drv" builds))))))
-
-  (test-assert "db-get-builds no-dependencies"
-    (begin
       (db-update-build-status! "/build-1.drv"
                                (build-status scheduled))
       (db-update-build-status! "/build-2.drv"
-                               (build-status succeeded))
-      (let ((builds
-             (map (cut assq-ref <> #:derivation)
-                  (db-get-builds `((no-dependencies . #t))))))
-        (member "/build-1.drv" builds))))
+                               (build-status scheduled))
+      (string=? (assq-ref (db-get-pending-build "x86_64-linux")
+                          #:derivation)
+                "/build-2.drv")))
 
   (test-assert "dependencies trigger"
     (begin



reply via email to

[Prev in Thread] Current Thread [Next in Thread]