database: Add "db-restart-evaluation!" support.

* src/cuirass/database.scm (db-restart-evaluation!): New procedure.
* tests/database.scm (db-restart-evaluation!): New test.
This commit is contained in:
Mathieu Othacehe 2021-02-18 15:12:54 +01:00
parent 04185edba6
commit 4a0cea2245
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
2 changed files with 14 additions and 0 deletions

View File

@ -70,6 +70,7 @@
db-update-build-status!
db-update-build-worker!
db-restart-build!
db-restart-evaluation!
db-get-build-products
db-get-builds-by-search
db-get-builds
@ -841,6 +842,13 @@ UPDATE Builds SET stoptime =" now
(build-status scheduled)
"WHERE id=" build-id ";")))
(define (db-restart-evaluation! eval-id)
"Restart the evaluation with EVAL-ID id."
(with-db-worker-thread db
(exec-query/bind db "UPDATE Builds SET status="
(build-status scheduled)
"WHERE evaluation=" eval-id ";")))
(define (query->bind-arguments query-string)
"Return a list of keys to query strings by parsing QUERY-STRING."
(define status-values

View File

@ -496,6 +496,12 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 0, 0);")
(eq? (assq-ref (db-get-build "/new-build.drv") #:status)
(build-status scheduled))))
(test-assert "db-restart-evaluation!"
(let ((build (db-get-build "/old-build.drv")))
(db-restart-evaluation! (assq-ref build #:eval-id))
(eq? (assq-ref (db-get-build "/old-build.drv") #:status)
(build-status scheduled))))
(test-assert "db-close"
(begin
(exec-query (%db) (format #f "DROP OWNED BY CURRENT_USER;"))