[no subject]

[Ludovic Courtès]

branch: master
commit f5c2bafc63f5ec5fc504a50da7746a9d5ac57847
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Sep 22 09:17:05 2023 +0200

    database: ‘db-get-pending-build’ returns older builds first.
    
    * src/cuirass/database.scm (db-get-pending-build): Sort ‘timestamp’
    in ascending order.  Clarify docstring.
    * tests/database.scm (make-dummy-build): Add #:system, #:jobset, #:priority,
    and #:timestamp.
    ("db-get-builds no-dependencies"): Remove.
    ("db-get-pending-build"): New test.
---
 src/cuirass/database.scm |  6 ++---
 tests/database.scm       | 60 ++++++++++++++++++++++++++++++++++++++----------
 2 files changed, 51 insertions(+), 15 deletions(-)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index f08426b..7f7d60f 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -1590,8 +1590,8 @@ the database.  The returned list is guaranteed to not 
have any duplicates."
 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."
+  "Return the oldest pending build with no dependencies for SYSTEM that has the
+highest priority (lowest integer value)."
   (with-db-worker-thread db
     (match (expect-one-row
             (exec-query/bind db "
@@ -1601,7 +1601,7 @@ 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)
+ORDER BY Builds.priority ASC, Builds.timestamp ASC)
 SELECT id FROM pending_dependencies WHERE deps = 0 LIMIT 1;"))
       ((id) (db-get-build (string->number id)))
       (else #f))))
diff --git a/tests/database.scm b/tests/database.scm
index a7e5354..5e0dc73 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -86,6 +86,10 @@
 (define* (make-dummy-build drv
                            #:optional (eval-id 2)
                            #:key
+                           (system "x86_64-linux")
+                           (jobset "whatever")
+                           (priority 9)
+                           (timestamp 0)
                            (job-name "job")
                            (outputs
                             (list
@@ -94,12 +98,14 @@
                                      (item (format #f "~a.output" drv))))))
   (build (derivation drv)
          (evaluation-id eval-id)
-         (specification-name "whatever")
+         (specification-name jobset)
          (job-name job-name)
-         (system "x86_64-linux")
+         (system system)
          (nix-name "foo")
          (log "log")
-         (outputs outputs)))
+         (outputs outputs)
+         (priority priority)
+         (creation-time timestamp)))
 
 (define %dummy-worker
   (worker
@@ -880,15 +886,45 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 
0, 0);")
     (with-fibers
      (build-dependencies (db-get-build "/build-1.drv"))))
 
-  (test-assert "db-get-builds no-dependencies"
-    (with-fibers
-      (db-update-build-status! "/build-1.drv"
-                               (build-status scheduled))
-      (db-update-build-status! "/build-2.drv"
-                               (build-status scheduled))
-      (string=? (build-derivation
-                 (db-get-pending-build "x86_64-linux"))
-                "/build-2.drv")))
+  (test-equal "db-get-pending-build"
+    '("/pending-build-3.drv"                      ;high-priority first
+      "/pending-build-4.drv"
+      "/pending-build-1.drv"                      ;older first
+      "/pending-build-2.drv"
+      #f)                                         ;no more builds!
+    (with-fibers
+     (db-add-build (make-dummy-build "/pending-build-1.drv"
+                                     #:system "riscv-gnu"
+                                     #:priority 9 ;low priority
+                                     #:timestamp 1))
+     (db-add-build (make-dummy-build "/pending-build-2.drv"
+                                     #:system "riscv-gnu"
+                                     #:priority 9
+                                     #:timestamp 2))
+     (db-add-build (make-dummy-build "/pending-build-3.drv"
+                                     #:system "riscv-gnu"
+                                     #:priority 1 ;high priority
+                                     #:timestamp 3))
+     (db-add-build (make-dummy-build "/pending-build-4.drv"
+                                     #:system "riscv-gnu"
+                                     #:priority 1
+                                     #:timestamp 4))
+     (for-each (lambda (drv)
+                 (db-update-build-status! drv (build-status scheduled)))
+               '("/pending-build-1.drv"
+                 "/pending-build-2.drv"
+                 "/pending-build-3.drv"
+                 "/pending-build-4.drv"))
+     (let loop ((i 0)
+                (lst '()))
+       (if (= i 5)
+           (reverse lst)
+           (loop (+ 1 i)
+                 (let ((drv (and=> (pk (db-get-pending-build "riscv-gnu"))
+                                   build-derivation)))
+                   (when drv
+                     (db-update-build-status! drv (build-status succeeded)))
+                   (cons drv lst)))))))
 
   (test-assert "dependencies trigger"
     (with-fibers