mirror of
git://git.savannah.gnu.org/guix/guix-cuirass.git
synced 2023-12-14 06:03:04 +01:00
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.
This commit is contained in:
parent
70394149af
commit
d116dc36c3
|
@ -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
|
||||
|
|
|
@ -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;"))
|
||||
|
|
Loading…
Reference in a new issue