[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
branch master updated: Add build dependencies support.
|
From: |
Mathieu Othacehe |
|
Subject: |
branch master updated: Add build dependencies support. |
|
Date: |
Tue, 25 May 2021 07:36:52 -0400 |
This is an automated email from the git hooks/post-receive script.
mothacehe pushed a commit to branch master
in repository guix-cuirass.
The following commit(s) were added to refs/heads/master by this push:
new d1a95e8 Add build dependencies support.
d1a95e8 is described below
commit d1a95e8b33b454a45bda506a22a8b9d9d2c8b16e
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Sat May 1 17:30:19 2021 +0200
Add build dependencies support.
* src/schema.sql (BuildDependencies): New table.
* src/sql/upgrade-11.sql: New file.
* Makefile.am (dist_sql_DATA): Add it.
* src/cuirass/database.scm (db-add-build-dependencies,
db-get-build-dependencies,
db-update-failed-builds): New procedures.
* src/cuirass/http.scm (http-handler): Pass the build dependencies to the
build-details procedure.
* src/cuirass/scripts/remote-server.scm (pop-build): Select a build with no
dependencies.
(read-worker-exp): Remove the scheduled builds with failed dependencies.
* src/cuirass/templates.scm (build-details): Add a dependencies argument and
use it to display the build dependencies and their status.
* src/static/js/cuirass.js: Animate the dependencies collapse button.
* tests/database.scm ("db-add-build-dependencies",
"db-get-build-dependencies", "dependencies trigger"): New tests.
---
Makefile.am | 3 +-
src/cuirass/database.scm | 125 ++++++++++++++++++++++++++--------
src/cuirass/http.scm | 15 ++--
src/cuirass/scripts/remote-server.scm | 7 +-
src/cuirass/templates.scm | 65 +++++++++++-------
src/schema.sql | 60 ++++++++++++++--
src/sql/upgrade-11.sql | 43 ++++++++++++
src/static/js/cuirass.js | 10 +++
tests/database.scm | 70 +++++++++++++++++++
9 files changed, 336 insertions(+), 62 deletions(-)
diff --git a/Makefile.am b/Makefile.am
index 22a5051..8135feb 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -97,7 +97,8 @@ dist_sql_DATA = \
src/sql/upgrade-7.sql \
src/sql/upgrade-8.sql \
src/sql/upgrade-9.sql \
- src/sql/upgrade-10.sql
+ src/sql/upgrade-10.sql \
+ src/sql/upgrade-11.sql
dist_css_DATA = \
src/static/css/choices.min.css \
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 4f4fd98..701f9b1 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -71,6 +71,9 @@
db-get-build-percentages
db-get-jobs
db-get-jobs-history
+ db-add-build-dependencies
+ db-get-build-dependencies
+ db-update-failed-builds!
db-register-builds
db-update-build-status!
db-update-build-worker!
@@ -788,6 +791,45 @@ AND Jobs.name = ANY(:names);")
(#:jobs . ,(list job)))
evaluations))))))))))
+(define (db-add-build-dependencies source-derivation target-derivations)
+ "Insert into the BuildDependencies table the TARGET-DERIVATIONS as
+dependencies of the given SOURCE-DERIVATION."
+ (define target
+ (format #f "{~a}"
+ (string-join target-derivations ",")))
+
+ (with-db-worker-thread db
+ (exec-query/bind db "
+INSERT INTO BuildDependencies
+(SELECT Builds.id, deps.id FROM Builds,
+(SELECT id FROM Builds WHERE derivation = ANY(" target ")) deps
+WHERE Builds.derivation = " source-derivation ")
+ON CONFLICT ON CONSTRAINT builddependencies_pkey DO NOTHING;")))
+
+(define (db-get-build-dependencies build)
+ "Return the list of the given BUILD dependencies."
+ (with-db-worker-thread db
+ (let loop ((rows (exec-query/bind db "
+SELECT target FROM BuildDependencies WHERE source = " build))
+ (dependencies '()))
+ (match rows
+ (() (reverse dependencies))
+ (((target) . rest)
+ (loop rest
+ (cons (string->number target) dependencies)))))))
+
+(define (db-update-failed-builds!)
+ "Update the build status of the scheduled builds with failed dependencies to
+failed-dependency."
+ (with-db-worker-thread db
+ (exec-query/bind db "
+UPDATE Builds SET status = " (build-status failed-dependency)
+" FROM (SELECT Builds.id, count(dep.id) as deps FROM Builds
+LEFT JOIN BuildDependencies as bd ON bd.source = Builds.id
+INNER JOIN Builds AS dep ON bd.target = dep.id AND dep.status > 0
+WHERE Builds.status = " (build-status scheduled)
+" GROUP BY Builds.id) AS deps WHERE deps.id = Builds.id")))
+
(define (db-register-builds jobs eval-id specification)
(define (new-outputs? outputs)
(let ((new-outputs
@@ -812,39 +854,50 @@ AND Jobs.name = ANY(:names);")
(max-silent (assq-ref job #:max-silent-time))
(timeout (assq-ref job #:timeout))
(outputs (assq-ref job #:outputs))
- (cur-time (time-second (current-time time-utc))))
- (and (new-outputs? outputs)
- (let ((build `((#:derivation . ,drv)
- (#:eval-id . ,eval-id)
- (#:job-name . ,job-name)
- (#:system . ,system)
- (#:nix-name . ,nix-name)
-
- ;; XXX: We'd leave LOG to #f (i.e., NULL) but that
- ;; currently violates the non-NULL constraint.
- (#:log . ,(or log ""))
-
- (#:status . ,(build-status scheduled))
- (#:priority . ,(build-priority priority))
- (#:max-silent . ,max-silent)
- (#:timeout . ,timeout)
- (#:outputs . ,outputs)
- (#:timestamp . ,cur-time)
- (#:starttime . 0)
- (#:stoptime . 0))))
- (db-add-build build)))
+ (cur-time (time-second (current-time time-utc)))
+ (result
+ (and (new-outputs? outputs)
+ (let ((build `((#:derivation . ,drv)
+ (#:eval-id . ,eval-id)
+ (#:job-name . ,job-name)
+ (#:system . ,system)
+ (#:nix-name . ,nix-name)
+
+ ;; XXX: We'd leave LOG to #f (i.e., NULL) but
+ ;; that currently violates the non-NULL
+ ;; constraint.
+ (#:log . ,(or log ""))
+
+ (#:status . ,(build-status scheduled))
+ (#:priority . ,(build-priority priority))
+ (#:max-silent . ,max-silent)
+ (#:timeout . ,timeout)
+ (#:outputs . ,outputs)
+ (#:timestamp . ,cur-time)
+ (#:starttime . 0)
+ (#:stoptime . 0))))
+ (db-add-build build)
+ job))))
;; Always register JOB inside the Jobs table. If there are new outputs,
;; JOB will refer to the newly created build. Otherwise, it will refer
;; to the last build with the same build outputs.
- (db-add-job job eval-id)))
+ (db-add-job job eval-id)
+ result))
+
+ (define (register-dependencies job)
+ (let ((drv (assq-ref job #:derivation))
+ (inputs (or (assq-ref job #:inputs) '())))
+ (db-add-build-dependencies drv inputs)))
(with-db-worker-thread db
(log-message "Registering builds for evaluation ~a." eval-id)
(exec-query db "BEGIN TRANSACTION;")
- (let ((derivations (filter-map register jobs)))
- (exec-query db "COMMIT;")
- derivations)))
+ (let ((new-jobs (filter-map register jobs)))
+ ;; Register build dependencies after registering all the evaluation
+ ;; derivations.
+ (for-each register-dependencies new-jobs)
+ (exec-query db "COMMIT;"))))
(define (db-get-last-status drv)
"Return the status of the last completed build with the same 'job_name' and
@@ -1097,6 +1150,7 @@ CASE WHEN CAST(:borderlowid AS integer) IS NULL THEN
(define (where-conditions filters)
(define filter-name->sql
`((id . "Builds.id = :id")
+ (ids . "Builds.id = ANY(:ids)")
(jobset . "Specifications.name = :jobset")
(derivation . "Builds.derivation = :derivation")
(job . "Builds.job_name = :job")
@@ -1104,6 +1158,7 @@ CASE WHEN CAST(:borderlowid AS integer) IS NULL THEN
(worker . "Builds.worker = :worker")
(oldevaluation . "Builds.evaluation < :oldevaluation")
(evaluation . "Builds.evaluation = :evaluation")
+ (no-dependencies . "PD.deps = 0")
(status . ,(match (assq-ref filters 'status)
(#f #f)
('done "Builds.status >= 0")
@@ -1159,6 +1214,11 @@ OR :borderhightime IS NULL OR :borderhighid IS NULL)")))
(split checksums)
(split paths)))
+ (define (format-build-dependencies dependencies)
+ (if dependencies
+ (map string->number (string-split dependencies #\,))
+ '()))
+
(with-db-worker-thread db
(let* ((order (filters->order filters))
(where (match (where-conditions filters)
@@ -1175,7 +1235,7 @@ Builds.last_status, Builds.weather, Builds.priority,
Builds.max_silent,
Builds.timeout, Builds.job_name, Builds.system,
Builds.worker, Builds.nix_name, Builds.evaluation, agg.name, agg.outputs_name,
agg.outputs_path,agg.bp_build, agg.bp_type, agg.bp_file_size,
-agg.bp_checksum, agg.bp_path
+agg.bp_checksum, agg.bp_path, agg.bd_target
FROM
(SELECT B.id, B.derivation, B.name,
string_agg(Outputs.name, ',') AS outputs_name,
@@ -1184,10 +1244,12 @@ string_agg(cast(BP.id AS text), ',') AS bp_build,
string_agg(BP.type, ',') AS bp_type,
string_agg(cast(BP.file_size AS text), ',') AS bp_file_size,
string_agg(BP.checksum, ',') AS bp_checksum,
-string_agg(BP.path, ',') AS bp_path FROM
+string_agg(BP.path, ',') AS bp_path,
+build_dependencies(B.id) AS bd_target FROM
(SELECT Builds.id, Builds.derivation, Specifications.name FROM Builds
INNER JOIN Evaluations ON Builds.evaluation = Evaluations.id
INNER JOIN Specifications ON Evaluations.specification = Specifications.name
+LEFT JOIN pending_dependencies as PD on PD.id = Builds.id
~a
ORDER BY ~a
LIMIT :nr) B
@@ -1209,6 +1271,11 @@ ORDER BY ~a;"
name)
name))
(match name
+ ('ids
+ (format #f "{~a}"
+ (string-join
+ (map number->string value)
+ ",")))
('nr value)
('order #f) ; Doesn't need binding.
('status #f) ; Doesn't need binding.
@@ -1224,7 +1291,7 @@ ORDER BY ~a;"
job-name system worker nix-name eval-id
specification outputs-name outputs-path
products-id products-type products-file-size
- products-checksum products-path)
+ products-checksum products-path dependencies)
. rest)
(loop rest
(cons `((#:derivation . ,derivation)
@@ -1248,6 +1315,8 @@ ORDER BY ~a;"
(#:nix-name . ,nix-name)
(#:eval-id . ,(string->number eval-id))
(#:specification . ,specification)
+ (#:builddependencies .
+ ,(format-build-dependencies dependencies))
(#:outputs . ,(format-outputs outputs-name
outputs-path))
(#:buildproducts .
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index c4e229c..7ab8e47 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -718,6 +718,10 @@ passed, only display JOBS targeting this SYSTEM."
(('GET "build" (= string->number id) "details")
(let* ((build (and id (db-get-build id)))
(products (and build (assoc-ref build #:buildproducts)))
+ (dependencies
+ (and build
+ (db-get-builds
+ `((ids . ,(assoc-ref build #:builddependencies))))))
(history
(db-get-builds
`((jobset . ,(assq-ref build #:specification))
@@ -728,10 +732,13 @@ passed, only display JOBS targeting this SYSTEM."
(nr . 5)))))
(if build
(respond-html
- (html-page (string-append "Build " (number->string id))
- (build-details build products history)
- `(((#:name . ,(assq-ref build #:specification))
- (#:link . ,(string-append "/jobset/" (assq-ref build
#:specification)))))))
+ (html-page
+ (string-append "Build " (number->string id))
+ (build-details build dependencies products history)
+ `(((#:name . ,(assq-ref build #:specification))
+ (#:link
+ . ,(string-append "/jobset/"
+ (assq-ref build #:specification)))))))
(respond-build-not-found id))))
(('GET "build" (= string->number id) "log" "raw")
(let* ((build (and id (db-get-build id)))
diff --git a/src/cuirass/scripts/remote-server.scm
b/src/cuirass/scripts/remote-server.scm
index 94ce3ea..1609e85 100644
--- a/src/cuirass/scripts/remote-server.scm
+++ b/src/cuirass/scripts/remote-server.scm
@@ -182,6 +182,7 @@ Start a remote build server.\n") (%program-name))
(match (db-get-builds `((status . scheduled)
(system . ,system)
(order . priority+timestamp)
+ (no-dependencies . #t)
(nr . 1)))
((build) build)
(() #f))))))
@@ -217,7 +218,11 @@ be used to reply to the worker."
#:timeout timeout
#:max-silent max-silent)))
(reply-worker
- (zmq-no-build-message)))))
+ (zmq-no-build-message)))
+
+ ;; Do some clean-up and remove the scheduled builds with failed
+ ;; dependencies.
+ (db-update-failed-builds!)))
(('worker-ping worker)
(update-worker! worker))
(('build-started ('drv drv) ('worker worker))
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index 567b8ee..2cc440f 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -637,27 +637,10 @@ the existing SPEC otherwise."
(class "btn btn-primary"))
" Submit")))))))
-(define (build-details build products history)
+(define (build-details build dependencies products history)
"Return HTML showing details for the BUILD."
(define status (assq-ref build #:status))
(define weather (assq-ref build #:weather))
- (define blocking-outputs
- (or (and-let* (((= (build-status failed-dependency) status))
- (drv (false-if-exception
- (read-derivation-from-file
- (assq-ref build #:derivation)))))
- (append-map (lambda (drv)
- (match (derivation->output-paths drv)
- (((_ . items) ...)
- items)))
- (filter (compose derivation-log-file
- derivation-file-name)
- (with-store store
- (derivation-build-plan
- store (list (derivation-input drv))
- #:substitutable-info (const #f))))))
- '()))
-
(define completed?
(or (= (build-status succeeded) status)
(= (build-status failed) status)))
@@ -665,6 +648,11 @@ the existing SPEC otherwise."
(define evaluation
(assq-ref build #:eval-id))
+ (define (find-dependency id)
+ (find (lambda (build)
+ (eq? (assoc-ref build #:id) id))
+ dependencies))
+
(define (history-table-row build)
(define status
(assq-ref build #:status))
@@ -710,12 +698,7 @@ the existing SPEC otherwise."
(tr (th "Status")
(td (span (@ (class ,(status-class status))
(title ,(status-title status)))
- ,(string-append " " (status-title status)))
- ,@(map (lambda (output)
- `((br)
- (a (@ (href ,(string-append "/log/" (basename
output))))
- ,output)))
- blocking-outputs)))
+ ,(string-append " " (status-title status)))))
(tr (th "System")
(td ,(assq-ref build #:system)))
(tr (th "Name")
@@ -746,6 +729,40 @@ the existing SPEC otherwise."
"raw")))
(tr (th "Derivation")
(td (pre ,(assq-ref build #:derivation))))
+ (tr (th "Dependencies")
+ (td
+ (@ (class "dependencies"))
+ ,@(let ((dependencies
+ (assq-ref build #:builddependencies))
+ (max-items 9))
+ `(,(map (lambda (id index)
+ (let* ((build (find-dependency id))
+ (status (assoc-ref build #:status)))
+ `((div
+ ,@(if (> index max-items)
+ '((@ (class "collapse collapse-dep")))
+ '())
+ (span (@ (class ,(status-class status))
+ (title ,(status-title status))
+ (aria-hidden "true"))
+ "")
+ " "
+ (a (@ (href "/build/" ,id "/details"))
+ ,(assoc-ref build #:nix-name))
+ (br)))))
+ dependencies
+ (iota (length dependencies)))
+ ,@(if (> (length dependencies) max-items)
+ '((button (@ (id "collapse-dep-btn")
+ (class "btn btn-primary")
+ (type "button")
+ (data-toggle "collapse")
+ (data-target ".collapse-dep")
+ (aria-expanded "false")
+ (aria-controls "collapse-dep")
+ (aria-label "Toggle dependencies
dropdown"))
+ "Show more"))
+ '())))))
(tr (th "Outputs")
(td ,(map (match-lambda ((out (#:path . path))
`(pre ,path)))
diff --git a/src/schema.sql b/src/schema.sql
index d1479a0..db78d4f 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -58,6 +58,14 @@ CREATE TABLE Builds (
FOREIGN KEY (evaluation) REFERENCES Evaluations(id) ON DELETE CASCADE
);
+CREATE TABLE BuildDependencies (
+ source INTEGER NOT NULL,
+ target INTEGER NOT NULL,
+ PRIMARY KEY (source, target),
+ FOREIGN KEY (source) REFERENCES Builds(id) ON DELETE CASCADE,
+ FOREIGN KEY (target) REFERENCES Builds(id) ON DELETE CASCADE
+);
+
CREATE TABLE Jobs (
name TEXT NOT NULL,
evaluation INTEGER NOT NULL,
@@ -145,17 +153,61 @@ CREATE TRIGGER build_status AFTER UPDATE ON Builds
FOR EACH ROW
EXECUTE PROCEDURE update_job_status();
+-- Return the list of comma separated dependencies of BUILD.
+CREATE FUNCTION build_dependencies(build bigint)
+RETURNS TABLE (dependencies text) AS $$
+SELECT string_agg(cast(BD.target AS text), ',')
+FROM BuildDependencies as BD
+WHERE BD.source = $1
+$$ LANGUAGE sql;
+
+-- Return the count of pending dependencies for all the scheduled builds.
+CREATE VIEW pending_dependencies AS
+SELECT Builds.id, count(dep.id) as deps FROM Builds
+LEFT JOIN BuildDependencies as bd ON bd.source = Builds.id
+LEFT JOIN Builds AS dep ON bd.target = dep.id AND dep.status != 0
+WHERE Builds.status = -2 GROUP BY Builds.id;
+
+-- When a build status is set to failed, update the build status of all the
+-- depending builds.
+CREATE OR REPLACE FUNCTION update_build_dependencies()
+RETURNS TRIGGER AS $$
+BEGIN
+-- Check if the build is failing.
+IF NEW.status > 0 AND NEW.status != OLD.status THEN
+
+-- Select all the builds depending of the failing build.
+WITH RECURSIVE deps AS (
+SELECT source FROM BuildDependencies WHERE target = NEW.id
+UNION
+SELECT BD.source FROM deps INNER JOIN BuildDependencies as BD
+ON BD.target = deps.source)
+
+-- If the build is cancelled, update all the depending build status to
+-- cancelled. Otherwise update the build status of the depending builds to
+-- failed-dependency.
+UPDATE Builds SET status =
+CASE
+WHEN NEW.status = 4 THEN 4 ELSE 2 END
+FROM deps WHERE Builds.id = deps.source;
+END IF;
+RETURN null;
+END
+$$ LANGUAGE plpgsql;
+
+CREATE TRIGGER build_dependencies AFTER UPDATE ON Builds
+FOR EACH ROW
+WHEN (pg_trigger_depth() = 0) --disable trigger cascading.
+EXECUTE PROCEDURE update_build_dependencies();
+
CREATE INDEX Jobs_name ON Jobs (name);
CREATE INDEX Jobs_system_status ON Jobs (system, status);
CREATE INDEX Jobs_build ON Jobs (build); --speeds up delete cascade.
-
CREATE INDEX Evaluations_status_index ON Evaluations (id, status);
CREATE INDEX Evaluations_specification_index ON Evaluations (specification, id
DESC);
-
CREATE INDEX Outputs_derivation_index ON Outputs (derivation);
-
CREATE INDEX BuildProducts_build ON BuildProducts(build); --speeds up delete
cascade.
-
CREATE INDEX Notifications_build ON Notifications(build); --speeds up delete
cascade.
+CREATE INDEX BuildDependencies_target ON BuildDependencies(target); --speeds
up delete cascade.
COMMIT;
diff --git a/src/sql/upgrade-11.sql b/src/sql/upgrade-11.sql
new file mode 100644
index 0000000..16fbb2a
--- /dev/null
+++ b/src/sql/upgrade-11.sql
@@ -0,0 +1,43 @@
+BEGIN TRANSACTION;
+
+CREATE FUNCTION build_dependencies(build bigint)
+RETURNS TABLE (dependencies text) AS $$
+SELECT string_agg(cast(BD.target AS text), ',')
+FROM BuildDependencies as BD
+WHERE BD.source = $1
+$$ LANGUAGE sql;
+
+CREATE VIEW pending_dependencies AS
+SELECT Builds.id, count(dep.id) as deps FROM Builds
+LEFT JOIN BuildDependencies as bd ON bd.source = Builds.id
+LEFT JOIN Builds AS dep ON bd.target = dep.id AND dep.status != 0
+WHERE Builds.status = -2 GROUP BY Builds.id;
+
+CREATE OR REPLACE FUNCTION update_build_dependencies()
+RETURNS TRIGGER AS $$
+BEGIN
+IF NEW.status > 0 AND NEW.status != OLD.status THEN
+
+WITH RECURSIVE deps AS (
+SELECT source FROM BuildDependencies WHERE target = NEW.id
+UNION
+SELECT BD.source FROM deps INNER JOIN BuildDependencies as BD
+ON BD.target = deps.source)
+
+UPDATE Builds SET status =
+CASE
+WHEN NEW.status = 4 THEN 4 ELSE 2 END
+FROM deps WHERE Builds.id = deps.source;
+END IF;
+RETURN null;
+END
+$$ LANGUAGE plpgsql;
+
+CREATE TRIGGER build_dependencies AFTER UPDATE ON Builds
+FOR EACH ROW
+WHEN (pg_trigger_depth() = 0)
+EXECUTE PROCEDURE update_build_dependencies();
+
+CREATE INDEX BuildDependencies_target ON BuildDependencies(target); --speeds
up delete cascade.
+
+COMMIT;
diff --git a/src/static/js/cuirass.js b/src/static/js/cuirass.js
index 67ea397..bb7b107 100644
--- a/src/static/js/cuirass.js
+++ b/src/static/js/cuirass.js
@@ -52,6 +52,16 @@ $(document).ready(function() {
}
}
});
+ /* Build details page. */
+ $('.dependencies').collapse({
+ toggle: false
+ })
+ $('.dependencies').on('hide.bs.collapse', function () {
+ $('#collapse-dep-btn').text("Show more");
+ })
+ $('.dependencies').on('show.bs.collapse', function () {
+ $('#collapse-dep-btn').text("Show less");
+ })
/* Dashboard page. */
$(function(){
diff --git a/tests/database.scm b/tests/database.scm
index b54bae2..21a6fa8 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -679,6 +679,76 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0,
0, 0);")
(let ((id (db-register-dashboard "guix" "emacs")))
(assq-ref (db-get-dashboard id) #:specification)))
+ (test-assert "db-add-build-dependencies"
+ (begin
+ (db-add-build-dependencies "/build-1.drv"
+ (list "/build-2.drv"))))
+
+ (test-assert "db-get-build-dependencies"
+ (begin
+ (let* ((drv1 "/build-1.drv")
+ (drv2 "/build-2.drv")
+ (id1 (assq-ref (db-get-build drv1) #:id))
+ (id2 (assq-ref (db-get-build drv2) #:id)))
+ (match (db-get-build-dependencies id1)
+ ((id) (eq? id id2))))))
+
+ (test-assert "db-get-builds no-dependencies"
+ (begin
+ (db-update-build-status! "/build-2.drv"
+ (build-status scheduled))
+ (let ((builds
+ (map (cut assq-ref <> #:derivation)
+ (db-get-builds `((no-dependencies . #t))))))
+ (and (member "/build-2.drv" builds)
+ (not (member "/build-1.drv" builds))))))
+
+ (test-assert "db-get-builds no-dependencies"
+ (begin
+ (db-update-build-status! "/build-1.drv"
+ (build-status scheduled))
+ (db-update-build-status! "/build-2.drv"
+ (build-status succeeded))
+ (let ((builds
+ (map (cut assq-ref <> #:derivation)
+ (db-get-builds `((no-dependencies . #t))))))
+ (member "/build-1.drv" builds))))
+
+ (test-assert "dependencies trigger"
+ (begin
+ (let ((drv-1
+ (db-add-build (make-dummy-build "/build-dep-1.drv")))
+ (drv-2
+ (db-add-build (make-dummy-build "/build-dep-2.drv")))
+ (drv-3
+ (db-add-build (make-dummy-build "/build-dep-3.drv")))
+ (drv-4
+ (db-add-build (make-dummy-build "/build-dep-4.drv")))
+ (drv-5
+ (db-add-build (make-dummy-build "/build-dep-5.drv")))
+ (drv-6
+ (db-add-build (make-dummy-build "/build-dep-6.drv")))
+ (drv-7
+ (db-add-build (make-dummy-build "/build-dep-7.drv")))
+ (status (lambda (drv)
+ (assq-ref (db-get-build drv) #:status))))
+ (db-add-build-dependencies "/build-dep-2.drv"
+ (list "/build-dep-1.drv"))
+ (db-add-build-dependencies "/build-dep-4.drv"
+ (list "/build-dep-1.drv"
+ "/build-dep-3.drv"))
+ (db-add-build-dependencies "/build-dep-6.drv"
+ (list "/build-dep-4.drv"
+ "/build-dep-5.drv"))
+ (db-add-build-dependencies "/build-dep-7.drv"
+ (list "/build-dep-4.drv"))
+ (db-update-build-status! drv-1 (build-status failed))
+ (db-update-build-status! drv-2 (build-status succeeded))
+ (db-update-build-status! drv-5 (build-status canceled))
+ (and (eq? (status drv-4) (build-status failed-dependency))
+ (eq? (status drv-6) (build-status canceled))
+ (eq? (status drv-7) (build-status failed-dependency))))))
+
(test-assert "db-close"
(begin
(false-if-exception (delete-file tmp-mail))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- branch master updated: Add build dependencies support.,
Mathieu Othacehe <=