aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--guix-data-service/jobs/load-new-guix-revision.scm24
-rw-r--r--guix-data-service/model/system-test.scm67
-rw-r--r--guix-data-service/web/revision/controller.scm21
-rw-r--r--guix-data-service/web/revision/html.scm20
-rw-r--r--sqitch/deploy/guix_revision_system_test_derivations_add_system.sql18
-rw-r--r--sqitch/revert/guix_revision_system_test_derivations_add_system.sql7
-rw-r--r--sqitch/sqitch.plan1
-rw-r--r--sqitch/verify/guix_revision_system_test_derivations_add_system.sql7
8 files changed, 126 insertions, 39 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index b554f99..d5a54f9 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -286,16 +286,24 @@ WHERE job_id = $1"
result)))))
(define (all-inferior-system-tests inf store)
+ (define inferior-%supported-systems
+ (inferior-eval '(@ (guix packages) %supported-systems) inf))
+
(define extract
- '(lambda (store)
+ `(lambda (store)
(map
(lambda (system-test)
(list (system-test-name system-test)
(system-test-description system-test)
- (derivation-file-name
- (run-with-store store
- (mbegin %store-monad
- (system-test-value system-test))))
+ (map (lambda (system)
+ (cons
+ system
+ (parameterize ((%current-system system))
+ (derivation-file-name
+ (run-with-store store
+ (mbegin %store-monad
+ (system-test-value system-test)))))))
+ (list ,@inferior-%supported-systems))
(match (system-test-location system-test)
(($ <location> file line column)
(list file
@@ -307,8 +315,10 @@ WHERE job_id = $1"
(with-time-logging "getting system tests"
(inferior-eval-with-store inf store extract))))
- (for-each (lambda (derivation-file-name)
- (add-temp-root store derivation-file-name))
+ (for-each (lambda (derivation-file-names-by-system)
+ (for-each (lambda (derivation-file-name)
+ (add-temp-root store derivation-file-name))
+ (map cdr derivation-file-names-by-system)))
(map third system-test-data))
system-test-data))
diff --git a/guix-data-service/model/system-test.scm b/guix-data-service/model/system-test.scm
index 87bb647..090ba58 100644
--- a/guix-data-service/model/system-test.scm
+++ b/guix-data-service/model/system-test.scm
@@ -30,43 +30,55 @@
(define (insert-system-tests-for-guix-revision conn
guix-revision-id
system-test-data)
- (let ((system-test-ids
- (insert-missing-data-and-return-all-ids
- conn
- "system_tests"
- '(name description location_id)
- (map (match-lambda
- ((name description derivation-file-name location-data)
- (list name
- description
- (location->location-id
- conn
- (apply location location-data)))))
- system-test-data)))
- (derivation-ids
- (derivation-file-names->derivation-ids
- conn
- (map third system-test-data))))
+ (let* ((system-test-ids
+ (insert-missing-data-and-return-all-ids
+ conn
+ "system_tests"
+ '(name description location_id)
+ (map (match-lambda
+ ((name description derivation-file-names-by-system location-data)
+ (list name
+ description
+ (location->location-id
+ conn
+ (apply location location-data)))))
+ system-test-data)))
+ (data
+ (append-map
+ (lambda (system-test-id derivation-file-names-by-system)
+ (let ((systems
+ (map car derivation-file-names-by-system))
+ (derivation-ids
+ (derivation-file-names->derivation-ids
+ conn
+ (map cdr derivation-file-names-by-system))))
+ (map (lambda (system derivation-id)
+ (list guix-revision-id
+ system-test-id
+ derivation-id
+ system))
+ systems
+ derivation-ids)))
+ system-test-ids
+ (map third system-test-data))))
(exec-query
conn
(string-append
"
INSERT INTO guix_revision_system_test_derivations
- (guix_revision_id, system_test_id, derivation_id)
+ (guix_revision_id, system_test_id, derivation_id, system)
VALUES "
(string-join
- (map (lambda (system-test-id derivation-id)
- (simple-format #f "(~A, ~A, ~A)"
- guix-revision-id
- system-test-id
- derivation-id))
- system-test-ids
- derivation-ids)
+ (map (lambda (vals)
+ (apply simple-format #f "(~A, ~A, ~A, '~A')"
+ vals))
+ data)
", "))))
#t)
(define (select-system-tests-for-guix-revision conn
+ system
commit-hash)
(define query
"
@@ -103,7 +115,8 @@ LEFT OUTER JOIN (
ON builds.id = latest_build_status.build_id
INNER JOIN guix_revisions
ON guix_revisions.id = guix_revision_system_test_derivations.guix_revision_id
-WHERE guix_revisions.commit = $1
+WHERE guix_revision_system_test_derivations.system = $1 AND
+ guix_revisions.commit = $2
GROUP BY system_tests.name, system_tests.description,
locations.file, locations.line, locations.column_number,
derivations.file_name
@@ -125,4 +138,4 @@ ORDER BY name ASC")
(assoc-ref build "status"))
(vector->list
(json-string->scm builds-json))))))
- (exec-query conn query (list commit-hash))))
+ (exec-query conn query (list system commit-hash))))
diff --git a/guix-data-service/web/revision/controller.scm b/guix-data-service/web/revision/controller.scm
index 46b69d9..57156a4 100644
--- a/guix-data-service/web/revision/controller.scm
+++ b/guix-data-service/web/revision/controller.scm
@@ -216,10 +216,15 @@
commit-hash)))
(('GET "revision" commit-hash "system-tests")
(if (guix-commit-exists? conn commit-hash)
- (render-revision-system-tests mime-types
- conn
- commit-hash
- #:path-base path)
+ (let ((parsed-query-parameters
+ (parse-query-parameters
+ request
+ `((system ,parse-system #:default "x86_64-linux")))))
+ (render-revision-system-tests mime-types
+ conn
+ commit-hash
+ parsed-query-parameters
+ #:path-base path))
(render-unknown-revision mime-types
conn
commit-hash)))
@@ -360,6 +365,7 @@
(define* (render-revision-system-tests mime-types
conn
commit-hash
+ query-parameters
#:key
(path-base "/revision/")
(header-text
@@ -367,7 +373,10 @@
(header-link
(string-append "/revision/" commit-hash)))
(let ((system-tests
- (select-system-tests-for-guix-revision conn commit-hash)))
+ (select-system-tests-for-guix-revision
+ conn
+ (assq-ref query-parameters 'system)
+ commit-hash)))
(case (most-appropriate-mime-type
'(application/json text/html)
mime-types)
@@ -381,6 +390,8 @@
system-tests
(git-repositories-containing-commit conn
commit-hash)
+ (valid-systems conn)
+ query-parameters
#:path-base path-base
#:header-text header-text
#:header-link header-link))))))
diff --git a/guix-data-service/web/revision/html.scm b/guix-data-service/web/revision/html.scm
index 4de9a76..a199197 100644
--- a/guix-data-service/web/revision/html.scm
+++ b/guix-data-service/web/revision/html.scm
@@ -653,6 +653,8 @@
(define* (view-revision-system-tests commit-hash
system-tests
git-repositories
+ valid-systems
+ query-parameters
#:key (path-base "/revision/")
header-text header-link)
(layout
@@ -672,6 +674,24 @@
(div
(@ (class "col-md-12"))
(h1 "System tests")
+ (div
+ (@ (class "well"))
+ (form
+ (@ (method "get")
+ (action "")
+ (style "padding-bottom: 0")
+ (class "form-horizontal"))
+ ,(form-horizontal-control
+ "System" query-parameters
+ #:options valid-systems
+ #:help-text "Only include system test derivations for this system."
+ #:allow-selecting-multiple-options #f
+ #:font-family "monospace")
+ (div (@ (class "form-group form-group-lg"))
+ (div (@ (class "col-sm-offset-2 col-sm-10"))
+ (button (@ (type "submit")
+ (class "btn btn-lg btn-primary"))
+ "Update results")))))
(table
(@ (class "table"))
(thead
diff --git a/sqitch/deploy/guix_revision_system_test_derivations_add_system.sql b/sqitch/deploy/guix_revision_system_test_derivations_add_system.sql
new file mode 100644
index 0000000..43aa9b4
--- /dev/null
+++ b/sqitch/deploy/guix_revision_system_test_derivations_add_system.sql
@@ -0,0 +1,18 @@
+-- Deploy guix-data-service:guix_revision_system_test_derivations_add_system to pg
+
+BEGIN;
+
+ALTER TABLE guix_revision_system_test_derivations ADD COLUMN system varchar;
+
+-- Assume that existing values are for 'x86_64-linux'
+UPDATE guix_revision_system_test_derivations SET system = 'x86_64-linux';
+
+ALTER TABLE guix_revision_system_test_derivations ALTER system SET NOT NULL;
+
+ALTER TABLE guix_revision_system_test_derivations
+ DROP CONSTRAINT guix_revision_system_test_derivations_pkey;
+
+ALTER TABLE guix_revision_system_test_derivations
+ ADD CONSTRAINT guix_revision_system_test_derivations_pkey PRIMARY KEY (guix_revision_id, system_test_id, system, derivation_id);
+
+COMMIT;
diff --git a/sqitch/revert/guix_revision_system_test_derivations_add_system.sql b/sqitch/revert/guix_revision_system_test_derivations_add_system.sql
new file mode 100644
index 0000000..cfb69f9
--- /dev/null
+++ b/sqitch/revert/guix_revision_system_test_derivations_add_system.sql
@@ -0,0 +1,7 @@
+-- Revert guix-data-service:guix_revision_system_test_derivations_add_system from pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/sqitch.plan b/sqitch/sqitch.plan
index 891d595..975d7ee 100644
--- a/sqitch/sqitch.plan
+++ b/sqitch/sqitch.plan
@@ -52,3 +52,4 @@ allow_including_and_excluding_branches_for_repositories 2020-02-08T11:30:02Z Chr
channel_instance_derivations 2020-02-10T07:59:03Z Christopher Baines <mail@cbaines.net> # Add tables to store derivations for channel instances
update_build_servers_build_config 2020-02-13T20:07:19Z Christopher Baines <mail@cbaines.net> # Update build_servers_build_config values
make_some_constraints_deferrable 2020-02-16T10:54:22Z Christopher Baines <mail@cbaines.net> # Make some constraints deferrable
+guix_revision_system_test_derivations_add_system 2020-03-19T21:30:33Z Christopher Baines <mail@cbaines.net> # Add a system column to the guix_revision_system_test_derivations table
diff --git a/sqitch/verify/guix_revision_system_test_derivations_add_system.sql b/sqitch/verify/guix_revision_system_test_derivations_add_system.sql
new file mode 100644
index 0000000..db42d8d
--- /dev/null
+++ b/sqitch/verify/guix_revision_system_test_derivations_add_system.sql
@@ -0,0 +1,7 @@
+-- Verify guix-data-service:guix_revision_system_test_derivations_add_system on pg
+
+BEGIN;
+
+-- XXX Add verifications here.
+
+ROLLBACK;
generated by cgit v1.2.3 (git 2.25.4) at 2024-05-18 07:45:47 +0000