cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Generate and store system test derivations for all supported systems

Browse source 
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.
This commit is contained in:
Christopher Baines 2020-03-20 01:41:32 +00:00
parent e0f920bb14
commit c44297b615
8 changed files with 126 additions and 39 deletions
Download patch file Download diff file Expand all files Collapse all files

14
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -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)
(map (lambda (system)
(cons
system
(parameterize ((%current-system system))
(derivation-file-name
(run-with-store store
(mbegin %store-monad
(system-test-value system-test))))
(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-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))

37
guix-data-service/model/system-test.scm
View file

@ -30,22 +30,36 @@
(define (insert-system-tests-for-guix-revision conn
guix-revision-id
system-test-data)
(let ((system-test-ids
(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)
((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
@ -53,20 +67,18 @@
(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))))

15
guix-data-service/web/revision/controller.scm
View file

@ -216,10 +216,15 @@
commit-hash)))
(('GET "revision" commit-hash "system-tests")
(if (guix-commit-exists? conn commit-hash)
(let ((parsed-query-parameters
(parse-query-parameters
request
`((system ,parse-system #:default "x86_64-linux")))))
(render-revision-system-tests mime-types
conn
commit-hash
#:path-base path)
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))))))

20
guix-data-service/web/revision/html.scm
View file

@ -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

18
sqitch/deploy/guix_revision_system_test_derivations_add_system.sql Normal file
View file

@ -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;

7
sqitch/revert/guix_revision_system_test_derivations_add_system.sql Normal file
View file

@ -0,0 +1,7 @@
-- Revert guix-data-service:guix_revision_system_test_derivations_add_system from pg
BEGIN;
-- XXX Add DDLs here.
COMMIT;

1
sqitch/sqitch.plan
View file

@ -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

7
sqitch/verify/guix_revision_system_test_derivations_add_system.sql Normal file
View file

@ -0,0 +1,7 @@
-- Verify guix-data-service:guix_revision_system_test_derivations_add_system on pg
BEGIN;
-- XXX Add verifications here.
ROLLBACK;