mirror of
git://git.savannah.gnu.org/guix/guix-cuirass.git
synced 2023-12-14 06:03:04 +01:00
database: Add 'db-get-pending-derivations'.
* src/cuirass/database.scm (db-get-pending-derivations): New procedure. * tests/database.scm ("database")["db-get-pending-derivations"]: New test.
This commit is contained in:
parent
2feb3b8100
commit
fc24ca2eac
2 changed files with 40 additions and 0 deletions
|
@ -39,6 +39,7 @@
|
|||
db-add-evaluation
|
||||
db-add-derivation
|
||||
db-get-derivation
|
||||
db-get-pending-derivations
|
||||
build-status
|
||||
db-add-build
|
||||
db-update-build-status!
|
||||
|
@ -508,6 +509,22 @@ ORDER BY ~a, Builds.id ASC LIMIT :nr;" order))
|
|||
build)
|
||||
(() #f)))
|
||||
|
||||
(define (db-get-pending-derivations db)
|
||||
"Return the list of derivation file names corresponding to pending builds in
|
||||
DB. The returned list is guaranteed to not have any duplicates."
|
||||
;; This is of course much more efficient than calling 'delete-duplicates' on
|
||||
;; a list of results obtained without DISTINCT, both in space and time.
|
||||
;;
|
||||
;; Here we use a subquery so that sqlite can use two indexes instead of
|
||||
;; creating a "TEMP B-TREE" when doing a single flat query, as "EXPLAIN
|
||||
;; QUERY PLAN" shows.
|
||||
(map (match-lambda (#(drv) drv))
|
||||
(sqlite-exec db "
|
||||
SELECT DISTINCT derivation FROM (
|
||||
SELECT Derivations.derivation FROM Derivations INNER JOIN Builds
|
||||
WHERE Derivations.derivation = Builds.derivation AND Builds.status < 0
|
||||
);")))
|
||||
|
||||
(define (db-get-stamp db spec)
|
||||
"Return a stamp corresponding to specification SPEC in database DB."
|
||||
(let ((res (sqlite-exec db "SELECT * FROM Stamps WHERE specification="
|
||||
|
|
|
@ -192,6 +192,29 @@ INSERT INTO Evaluations (specification, revision) VALUES (3, 3);")
|
|||
(map summarize
|
||||
(db-get-builds db '((order status+submission-time))))))))
|
||||
|
||||
(test-equal "db-get-pending-derivations"
|
||||
'("/bar.drv" "/foo.drv")
|
||||
(with-temporary-database db
|
||||
;; Populate the 'Builds', 'Derivations', 'Evaluations', and
|
||||
;; 'Specifications' tables. Here, two builds map to the same derivation
|
||||
;; but the result of 'db-get-pending-derivations' must not contain any
|
||||
;; duplicate.
|
||||
(db-add-build db (make-dummy-build 1 #:drv "/foo.drv"
|
||||
#:outputs `(("out" . "/foo"))))
|
||||
(db-add-build db (make-dummy-build 2 #:drv "/bar.drv"
|
||||
#:outputs `(("out" . "/bar"))))
|
||||
(db-add-build db (make-dummy-build 3 #:drv "/foo.drv"
|
||||
#:outputs `(("out" . "/foo"))))
|
||||
(db-add-derivation db (make-dummy-derivation "/foo.drv" 1))
|
||||
(db-add-derivation db (make-dummy-derivation "/bar.drv" 2))
|
||||
(db-add-derivation db (make-dummy-derivation "/foo.drv" 3))
|
||||
(db-add-evaluation db (make-dummy-eval))
|
||||
(db-add-evaluation db (make-dummy-eval))
|
||||
(db-add-evaluation db (make-dummy-eval))
|
||||
(db-add-specification db example-spec)
|
||||
|
||||
(sort (db-get-pending-derivations db) string<?)))
|
||||
|
||||
(test-assert "db-close"
|
||||
(db-close (%db)))
|
||||
|
||||
|
|
Loading…
Reference in a new issue