[no subject]

[Mathieu Othacehe]

branch: master
commit d116dc36c3c51f23dc6c1d88ec85cff951663e43
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Tue Mar 9 18:45:47 2021 +0100

    database: Add db-cancel-pending-builds!.
    
    * src/cuirass/database.scm (db-cancel-pending-builds!): New procedure.
    * tests/database.scm ("db-cancel-pending-builds!"): New test.
---
 src/cuirass/database.scm | 9 +++++++++
 tests/database.scm       | 9 +++++++++
 2 files changed, 18 insertions(+)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index fe88cd6..e9f0385 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -74,6 +74,7 @@
             db-restart-build!
             db-restart-evaluation!
             db-retry-evaluation!
+            db-cancel-pending-builds!
             db-get-build-products
             db-get-builds-by-search
             db-get-builds
@@ -836,6 +837,14 @@ UPDATE Builds SET stoptime =" now
     (exec-query/bind db "\
 DELETE FROM Checkouts WHERE evaluation=" eval-id ";")))
 
+(define (db-cancel-pending-builds! eval-id)
+  "Cancel the pending builds of the evaluation with EVAL-ID id."
+  (with-db-worker-thread db
+    (exec-query/bind db "UPDATE Builds SET status="
+                     (build-status canceled)
+                     "WHERE evaluation=" eval-id
+                     "AND status = " (build-status started) ";")))
+
 (define (query->bind-arguments query-string)
   "Return a list of keys to query strings by parsing QUERY-STRING."
   (define status-values
diff --git a/tests/database.scm b/tests/database.scm
index e62c17f..ab6df55 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -541,6 +541,15 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 
0, 0);")
       (db-retry-evaluation! 4)
       (db-get-checkouts 4)))
 
+  (test-assert "db-cancel-pending-builds!"
+    (let* ((drv "/old-build.drv")
+           (build (db-get-build drv))
+           (eval-id (assq-ref build #:eval-id)))
+      (db-update-build-status! drv (build-status started))
+      (db-cancel-pending-builds! eval-id)
+      (eq? (assq-ref (db-get-build drv) #:status)
+           (build-status canceled))))
+
   (test-assert "db-close"
     (begin
       (exec-query (%db) (format #f "DROP OWNED BY CURRENT_USER;"))