diff options
| -rw-r--r-- | src/cuirass/database.scm | 17 | ||||
| -rw-r--r-- | tests/database.scm | 23 |
2 files changed, 40 insertions, 0 deletions
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))) |