branch: master
commit fc24ca2eac708695f663623a50f715db5ca914bd
Author: Ludovic Courtès <l...@gnu.org>
Date: Thu Apr 5 22:15:20 2018 +0200
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.
---
src/cuirass/database.scm | 17 +++++++++++++++++
tests/database.scm | 23 +++++++++++++++++++++++
2 files changed, 40 insertions(+)
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index b445719..4dda862 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -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="
diff --git a/tests/database.scm b/tests/database.scm
index f534f2b..847c8a6 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -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)))
