From d116dc36c3c51f23dc6c1d88ec85cff951663e43 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Tue, 9 Mar 2021 18:45:47 +0100 Subject: [PATCH] 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;"))