[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/02: Generate and store system test derivations for all supported syst
|
From: |
Christopher Baines |
|
Subject: |
02/02: Generate and store system test derivations for all supported systems |
|
Date: |
Fri, 20 Mar 2020 04:29:04 -0400 (EDT) |
cbaines pushed a commit to branch master
in repository data-service.
commit c44297b6159e0564ae65cbe887683020ac385e22
Author: Christopher Baines <address@hidden>
AuthorDate: Fri Mar 20 01:41:32 2020 +0000
Generate and store system test derivations for all supported systems
Rather than just the native system. I'm not quite sure of the value here,
as I
guess system tests should behave the same regardless of the way the software
is compiled, but this seems like it could be useful, and being explicit
about
the system the derivation is for is good.
---
guix-data-service/jobs/load-new-guix-revision.scm | 24 +++++---
guix-data-service/model/system-test.scm | 67 +++++++++++++---------
guix-data-service/web/revision/controller.scm | 21 +++++--
guix-data-service/web/revision/html.scm | 20 +++++++
...revision_system_test_derivations_add_system.sql | 18 ++++++
...revision_system_test_derivations_add_system.sql | 7 +++
sqitch/sqitch.plan | 1 +
...revision_system_test_derivations_add_system.sql | 7 +++
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
<address@hidden> # Add tables to store derivations for channel instances
update_build_servers_build_config 2020-02-13T20:07:19Z Christopher Baines
<address@hidden> # Update build_servers_build_config values
make_some_constraints_deferrable 2020-02-16T10:54:22Z Christopher Baines
<address@hidden> # Make some constraints deferrable
+guix_revision_system_test_derivations_add_system 2020-03-19T21:30:33Z
Christopher Baines <address@hidden> # 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;