Support comparing revision system test derivations
This should come in useful for testing patches, as you can see what system tests are affected, and check the build status.
This commit is contained in:
parent
dd044c9f53
commit
6f89066355
3 changed files with 505 additions and 4 deletions
|
|
@ -44,6 +44,8 @@
|
|||
|
||||
lint-warning-differences-data
|
||||
|
||||
system-test-derivations-differences-data
|
||||
|
||||
channel-news-differences-data))
|
||||
|
||||
(define (derivation-differences-data conn
|
||||
|
|
@ -963,6 +965,166 @@ ORDER BY coalesce(base_lint_warnings.name, target_lint_warnings.name) ASC, base_
|
|||
target-guix-revision-id
|
||||
locale)))
|
||||
|
||||
(define* (system-test-derivations-differences-data conn
|
||||
base_guix_revision_id
|
||||
target_guix_revision_id
|
||||
system)
|
||||
(define query
|
||||
(string-append "
|
||||
WITH base_system_tests AS (
|
||||
SELECT name, description,
|
||||
derivations.file_name AS derivation_file_name, derivation_output_details_set_id,
|
||||
locations.file, locations.line, locations.column_number
|
||||
FROM guix_revision_system_test_derivations
|
||||
INNER JOIN system_tests
|
||||
ON guix_revision_system_test_derivations.system_test_id = system_tests.id
|
||||
INNER JOIN locations
|
||||
ON system_tests.location_id = locations.id
|
||||
INNER JOIN derivations
|
||||
ON guix_revision_system_test_derivations.derivation_id = derivations.id
|
||||
INNER JOIN derivations_by_output_details_set
|
||||
ON guix_revision_system_test_derivations.derivation_id = derivations_by_output_details_set.derivation_id
|
||||
WHERE guix_revision_id = $1
|
||||
AND guix_revision_system_test_derivations.system = $3
|
||||
), target_system_tests AS (
|
||||
SELECT name, description,
|
||||
derivations.file_name AS derivation_file_name, derivation_output_details_set_id,
|
||||
locations.file, locations.line, locations.column_number
|
||||
FROM guix_revision_system_test_derivations
|
||||
INNER JOIN system_tests
|
||||
ON guix_revision_system_test_derivations.system_test_id = system_tests.id
|
||||
INNER JOIN locations
|
||||
ON system_tests.location_id = locations.id
|
||||
INNER JOIN derivations
|
||||
ON guix_revision_system_test_derivations.derivation_id = derivations.id
|
||||
INNER JOIN derivations_by_output_details_set
|
||||
ON guix_revision_system_test_derivations.derivation_id = derivations_by_output_details_set.derivation_id
|
||||
WHERE guix_revision_id = $2
|
||||
AND guix_revision_system_test_derivations.system = $3
|
||||
)
|
||||
SELECT base_system_tests.name, base_system_tests.description, base_system_tests.derivation_file_name,
|
||||
base_system_tests.file, base_system_tests.line, base_system_tests.column_number,
|
||||
(
|
||||
SELECT JSON_AGG(
|
||||
json_build_object(
|
||||
'build_server_id', builds.build_server_id,
|
||||
'build_server_build_id', builds.build_server_build_id,
|
||||
'status', latest_build_status.status,
|
||||
'timestamp', latest_build_status.timestamp,
|
||||
'build_for_equivalent_derivation',
|
||||
builds.derivation_file_name != base_system_tests.derivation_file_name
|
||||
)
|
||||
ORDER BY latest_build_status.timestamp
|
||||
)
|
||||
FROM builds
|
||||
INNER JOIN latest_build_status
|
||||
ON builds.id = latest_build_status.build_id
|
||||
WHERE builds.derivation_output_details_set_id =
|
||||
base_system_tests.derivation_output_details_set_id
|
||||
) AS base_builds,
|
||||
target_system_tests.name, target_system_tests.description, target_system_tests.derivation_file_name,
|
||||
target_system_tests.file, target_system_tests.line, target_system_tests.column_number,
|
||||
(
|
||||
SELECT JSON_AGG(
|
||||
json_build_object(
|
||||
'build_server_id', builds.build_server_id,
|
||||
'build_server_build_id', builds.build_server_build_id,
|
||||
'status', latest_build_status.status,
|
||||
'timestamp', latest_build_status.timestamp,
|
||||
'build_for_equivalent_derivation',
|
||||
builds.derivation_file_name != target_system_tests.derivation_file_name
|
||||
)
|
||||
ORDER BY latest_build_status.timestamp
|
||||
)
|
||||
FROM builds
|
||||
INNER JOIN latest_build_status
|
||||
ON builds.id = latest_build_status.build_id
|
||||
WHERE builds.derivation_output_details_set_id =
|
||||
target_system_tests.derivation_output_details_set_id
|
||||
) AS target_builds
|
||||
FROM base_system_tests
|
||||
FULL OUTER JOIN target_system_tests
|
||||
ON base_system_tests.name = target_system_tests.name
|
||||
WHERE
|
||||
base_system_tests.name IS NULL OR
|
||||
target_system_tests.name IS NULL OR
|
||||
base_system_tests.derivation_file_name != target_system_tests.derivation_file_name
|
||||
ORDER BY coalesce(base_system_tests.name, target_system_tests.name) ASC"))
|
||||
|
||||
(map
|
||||
(match-lambda
|
||||
((base_name base_description base_derivation_file_name
|
||||
base_file base_line base_column_number
|
||||
base_builds
|
||||
target_name target_description target_derivation_file_name
|
||||
target_file target_line target_column_number
|
||||
target_builds)
|
||||
(define (location->alist file line column-number)
|
||||
`((file . ,file)
|
||||
(line . ,(string->number line))
|
||||
(column_number . ,(string->number column-number))))
|
||||
|
||||
(peek base_name base_description base_derivation_file_name
|
||||
base_file base_line base_column_number
|
||||
base_builds
|
||||
target_name target_description target_derivation_file_name
|
||||
target_file target_line target_column_number
|
||||
target_builds)
|
||||
`((name . ,(or base_name target_name))
|
||||
(description . ,(if (and (string? base_description)
|
||||
(string? target_description)
|
||||
(string=? base_description target_description))
|
||||
base_description
|
||||
`((base . ,(if (null? base_description)
|
||||
'null
|
||||
base_description))
|
||||
(target . ,(if (null? target_description)
|
||||
'null
|
||||
target_description)))))
|
||||
(derivation . ,(if (and (string? base_derivation_file_name)
|
||||
(string? target_derivation_file_name)
|
||||
(string=? base_derivation_file_name
|
||||
target_derivation_file_name))
|
||||
base_derivation_file_name
|
||||
`((base . ,base_derivation_file_name)
|
||||
(target . ,target_derivation_file_name))))
|
||||
(location . ,(if
|
||||
(and (string? base_file)
|
||||
(string? target_file)
|
||||
(string=? base_file target_file)
|
||||
(string=? base_line target_line)
|
||||
(string=? base_column_number target_column_number))
|
||||
(location->alist base_file base_line base_column_number)
|
||||
`((base . ,(if (null? base_file)
|
||||
'null
|
||||
(location->alist
|
||||
base_file
|
||||
base_line
|
||||
base_column_number)))
|
||||
(target . ,(if (null? base_file)
|
||||
'null
|
||||
(location->alist
|
||||
target_file
|
||||
target_line
|
||||
target_column_number))))))
|
||||
(builds . ,(if (and (string? base_derivation_file_name)
|
||||
(string? target_derivation_file_name)
|
||||
(string=? base_derivation_file_name
|
||||
target_derivation_file_name))
|
||||
(json-string->scm base_builds)
|
||||
`((base . ,(if (null? base_builds)
|
||||
#()
|
||||
(json-string->scm base_builds)))
|
||||
(target . ,(if (null? target_builds)
|
||||
#()
|
||||
(json-string->scm target_builds)))))))))
|
||||
(exec-query-with-null-handling
|
||||
conn
|
||||
query
|
||||
(list base_guix_revision_id
|
||||
target_guix_revision_id
|
||||
system))))
|
||||
|
||||
(define (channel-news-differences-data conn
|
||||
base-guix-revision-id
|
||||
target-guix-revision-id)
|
||||
|
|
|
|||
|
|
@ -34,6 +34,7 @@
|
|||
#:use-module (guix-data-service comparison)
|
||||
#:use-module (guix-data-service jobs load-new-guix-revision)
|
||||
#:use-module (guix-data-service model guix-revision)
|
||||
#:use-module (guix-data-service model git-repository)
|
||||
#:use-module (guix-data-service model derivation)
|
||||
#:use-module (guix-data-service model build-server)
|
||||
#:use-module (guix-data-service model build-status)
|
||||
|
|
@ -189,6 +190,16 @@
|
|||
(target_commit ,parse-commit #:required)))))
|
||||
(render-compare/packages mime-types
|
||||
parsed-query-parameters)))
|
||||
(('GET "compare" "system-test-derivations")
|
||||
(let* ((parsed-query-parameters
|
||||
(parse-query-parameters
|
||||
request
|
||||
`((base_commit ,parse-commit #:required)
|
||||
(target_commit ,parse-commit #:required)
|
||||
(system ,parse-system #:default "x86_64-linux")))))
|
||||
|
||||
(render-compare/system-test-derivations mime-types
|
||||
parsed-query-parameters)))
|
||||
(_ #f)))
|
||||
|
||||
(define (texinfo->variants-alist s)
|
||||
|
|
@ -845,3 +856,76 @@
|
|||
base-packages-vhash
|
||||
target-packages-vhash)
|
||||
#:extra-headers http-headers-for-unchanging-content))))))))
|
||||
|
||||
(define (render-compare/system-test-derivations mime-types
|
||||
query-parameters)
|
||||
(if (any-invalid-query-parameters? query-parameters)
|
||||
(case (most-appropriate-mime-type
|
||||
'(application/json text/html)
|
||||
mime-types)
|
||||
((application/json)
|
||||
(render-json
|
||||
'((error . "invalid query"))))
|
||||
(else
|
||||
(letpar& ((systems
|
||||
(with-thread-postgresql-connection
|
||||
valid-systems))
|
||||
(build-server-urls
|
||||
(with-thread-postgresql-connection
|
||||
select-build-server-urls-by-id)))
|
||||
(render-html
|
||||
#:sxml (compare/system-test-derivations
|
||||
query-parameters
|
||||
'revision
|
||||
systems
|
||||
build-server-urls
|
||||
'()
|
||||
'()
|
||||
'())))))
|
||||
|
||||
(let ((base-commit (assq-ref query-parameters 'base_commit))
|
||||
(target-commit (assq-ref query-parameters 'target_commit))
|
||||
(system (assq-ref query-parameters 'system)))
|
||||
(letpar& ((data
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(system-test-derivations-differences-data
|
||||
conn
|
||||
(commit->revision-id conn base-commit)
|
||||
(commit->revision-id conn target-commit)
|
||||
system))))
|
||||
(build-server-urls
|
||||
(with-thread-postgresql-connection
|
||||
select-build-server-urls-by-id))
|
||||
(base-git-repositories
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(git-repositories-containing-commit conn base-commit))))
|
||||
(target-git-repositories
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(git-repositories-containing-commit conn target-commit))))
|
||||
(systems
|
||||
(with-thread-postgresql-connection
|
||||
valid-systems)))
|
||||
(case (most-appropriate-mime-type
|
||||
'(application/json text/html)
|
||||
mime-types)
|
||||
((application/json)
|
||||
(render-json
|
||||
`((revisions
|
||||
. ((base
|
||||
. ((commit . ,base-commit)))
|
||||
(target
|
||||
. ((commit . ,target-commit)))))
|
||||
(changes . ,(list->vector data)))))
|
||||
(else
|
||||
(render-html
|
||||
#:sxml (compare/system-test-derivations
|
||||
query-parameters
|
||||
'revision
|
||||
systems
|
||||
build-server-urls
|
||||
base-git-repositories
|
||||
target-git-repositories
|
||||
data))))))))
|
||||
|
|
|
|||
|
|
@ -23,6 +23,7 @@
|
|||
#:use-module (texinfo)
|
||||
#:use-module (texinfo html)
|
||||
#:use-module (guix-data-service web query-parameters)
|
||||
#:use-module (guix-data-service web util)
|
||||
#:use-module (guix-data-service web html-utils)
|
||||
#:use-module (guix-data-service web view html)
|
||||
#:export (compare
|
||||
|
|
@ -30,6 +31,7 @@
|
|||
compare/package-derivations
|
||||
compare-by-datetime/package-derivations
|
||||
compare/packages
|
||||
compare/system-test-derivations
|
||||
compare-invalid-parameters))
|
||||
|
||||
(define (compare-form-controls-for-mode mode query-parameters)
|
||||
|
|
@ -169,7 +171,7 @@
|
|||
`((div
|
||||
(@ (class "row") (style "clear: left;"))
|
||||
(div
|
||||
(@ (class "col-sm-6"))
|
||||
(@ (class "col-sm-10"))
|
||||
(div
|
||||
(@ (class "btn-group btn-group-lg")
|
||||
(role "group"))
|
||||
|
|
@ -190,9 +192,18 @@
|
|||
((eq? mode 'datetime) "compare-by-datetime"))
|
||||
"/package-derivations?"
|
||||
query-params)))
|
||||
"Compare package derivations")))
|
||||
"Compare package derivations")
|
||||
(a (@ (class "btn btn-default")
|
||||
(href ,(string-append
|
||||
"/"
|
||||
(cond
|
||||
((eq? mode 'revision) "compare")
|
||||
((eq? mode 'datetime) "compare-by-datetime"))
|
||||
"/system-test-derivations?"
|
||||
query-params)))
|
||||
"Compare system test derivations")))
|
||||
(div
|
||||
(@ (class "col-sm-6"))
|
||||
(@ (class "col-sm-2"))
|
||||
(a (@ (class "btn btn-default btn-lg pull-right")
|
||||
(href ,(string-append
|
||||
"/compare.json?" query-params)))
|
||||
|
|
@ -663,6 +674,17 @@
|
|||
#:optional
|
||||
base-revision-details
|
||||
target-revision-details)
|
||||
(define field-options
|
||||
(map
|
||||
(lambda (field)
|
||||
(cons field
|
||||
(hyphenate-words
|
||||
(string-downcase field))))
|
||||
'("(no additional fields)" "Builds")))
|
||||
|
||||
(define fields
|
||||
(assq-ref query-parameters 'field))
|
||||
|
||||
(layout
|
||||
#:body
|
||||
`(,(header)
|
||||
|
|
@ -775,6 +797,11 @@ and target derivations")
|
|||
"No base and target derivation to compare, or not
|
||||
enough builds to determine a change")))
|
||||
#:allow-selecting-multiple-options #f)
|
||||
,(form-horizontal-control
|
||||
"Fields" query-parameters
|
||||
#:name "field"
|
||||
#:options field-options
|
||||
#:help-text "Fields to return in the response.")
|
||||
,(form-horizontal-control
|
||||
"After name" query-parameters
|
||||
#:help-text
|
||||
|
|
@ -1004,3 +1031,231 @@ enough builds to determine a change")))
|
|||
(map (lambda (data)
|
||||
(take data 2))
|
||||
(vlist->list target-packages-vhash))))))))))))
|
||||
|
||||
(define* (compare/system-test-derivations query-parameters
|
||||
mode
|
||||
valid-systems
|
||||
build-server-urls
|
||||
base-git-repositories
|
||||
target-git-repositories
|
||||
changes
|
||||
#:optional
|
||||
base-revision-details
|
||||
target-revision-details)
|
||||
(layout
|
||||
#:body
|
||||
`(,(header)
|
||||
(div
|
||||
(@ (class "container-fluid"))
|
||||
(div
|
||||
(@ (class "row"))
|
||||
(div
|
||||
(@ (class "col-md-12"))
|
||||
,@(cond
|
||||
((any-invalid-query-parameters? query-parameters)
|
||||
'((h3 "Comparing system test derivations")))
|
||||
((eq? mode 'revision)
|
||||
(let ((base-commit (assq-ref query-parameters 'base_commit))
|
||||
(target-commit (assq-ref query-parameters 'target_commit)))
|
||||
`((h3
|
||||
(a (@ (href ,(string-append
|
||||
"/compare?base_commit="
|
||||
base-commit
|
||||
"&target_commit="
|
||||
target-commit)))
|
||||
"Comparing "
|
||||
(samp ,(string-take base-commit 8) "…")
|
||||
" and "
|
||||
(samp ,(string-take target-commit 8) "…"))))))
|
||||
((eq? mode 'datetime)
|
||||
(let ((base-branch (assq-ref query-parameters 'base_branch))
|
||||
(base-datetime (assq-ref query-parameters 'base_datetime))
|
||||
(target-branch (assq-ref query-parameters 'target_branch))
|
||||
(target-datetime (assq-ref query-parameters 'target_datetime)))
|
||||
`((h3
|
||||
(a (@ (href ,(string-append
|
||||
"/compare-by-datetime?"
|
||||
(query-parameters->string
|
||||
(filter (match-lambda
|
||||
((key . _)
|
||||
(member key '(base_branch
|
||||
base_datetime
|
||||
target_branch
|
||||
target_datetime))))
|
||||
query-parameters)))))
|
||||
"Comparing "
|
||||
(br)
|
||||
(samp (*ENTITY* nbsp) (*ENTITY* nbsp)
|
||||
,base-branch
|
||||
,@(map (lambda _ '(*ENTITY* nbsp))
|
||||
(iota (max
|
||||
0
|
||||
(- (string-length target-branch)
|
||||
(string-length base-branch))))))
|
||||
" at " ,(date->string base-datetime "~1 ~3")
|
||||
" to "
|
||||
(br)
|
||||
(samp (*ENTITY* nbsp) (*ENTITY* nbsp)
|
||||
,target-branch
|
||||
,@(map (lambda _ '(*ENTITY* nbsp))
|
||||
(iota (max 0
|
||||
(- (string-length base-branch)
|
||||
(string-length target-branch))))))
|
||||
" at " ,(date->string target-datetime "~1 ~3")))))))))
|
||||
(div
|
||||
(@ (class "row"))
|
||||
(div
|
||||
(@ (class "col-md-12"))
|
||||
(div
|
||||
(@ (class "well"))
|
||||
(form
|
||||
(@ (method "get")
|
||||
(action "")
|
||||
(class "form-horizontal"))
|
||||
,@(compare-form-controls-for-mode mode query-parameters)
|
||||
,(form-horizontal-control
|
||||
"System" query-parameters
|
||||
#:options valid-systems
|
||||
#:allow-selecting-multiple-options #f
|
||||
#:help-text "Only include derivations for this system."
|
||||
#: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")))
|
||||
(a (@ (class "btn btn-default btn-lg pull-right")
|
||||
(href ,(let ((query-parameter-string
|
||||
(query-parameters->string query-parameters)))
|
||||
(string-append
|
||||
"/"
|
||||
(cond
|
||||
((eq? mode 'revision) "compare")
|
||||
((eq? mode 'datetime) "compare-by-datetime"))
|
||||
"/system-test-derivations.json"
|
||||
(if (string-null? query-parameter-string)
|
||||
""
|
||||
(string-append "?" query-parameter-string))))))
|
||||
"View JSON")))))
|
||||
(div
|
||||
(@ (class "row"))
|
||||
(div
|
||||
(@ (class "col-sm-12"))
|
||||
(h1 "System test derivation changes")
|
||||
,(if
|
||||
(null? changes)
|
||||
'(p "No system test derivation changes")
|
||||
`(table
|
||||
(@ (class "table")
|
||||
(style "table-layout: fixed;"))
|
||||
(thead
|
||||
(tr
|
||||
(th (@ (class "col-sm-2"))
|
||||
"Name")
|
||||
(th (@ (class "col-sm-2"))
|
||||
"Description")
|
||||
(th (@ (class "col-sm-2"))
|
||||
"Location")
|
||||
(th "Derivation")
|
||||
(th (@ (class "col-sm-1"))
|
||||
"")))
|
||||
(tbody
|
||||
,@(append-map
|
||||
(match-lambda
|
||||
((('name . name)
|
||||
('description . description-data)
|
||||
('derivation . derivation-data)
|
||||
('location . location-data)
|
||||
('builds . builds-data))
|
||||
|
||||
(define (render-location git-repositories commit-hash
|
||||
data)
|
||||
(map
|
||||
(match-lambda
|
||||
((id label url cgit-url-base)
|
||||
(if
|
||||
(and cgit-url-base
|
||||
(not (string-null? cgit-url-base)))
|
||||
(match data
|
||||
((('file . file)
|
||||
('line . line)
|
||||
('column_number . column-number))
|
||||
`(a (@ (href
|
||||
,(string-append
|
||||
cgit-url-base "tree/"
|
||||
file "?id=" commit-hash
|
||||
"#n" (number->string line))))
|
||||
,file
|
||||
" (line: " ,line
|
||||
", column: " ,column-number ")")))
|
||||
'())))
|
||||
git-repositories))
|
||||
|
||||
(define cells
|
||||
(list
|
||||
(if (list? description-data)
|
||||
(cons
|
||||
`(td ,(assq-ref description-data 'base))
|
||||
`(td ,(assq-ref description-data 'target)))
|
||||
(cons
|
||||
`(td (@ (rowspan 2))
|
||||
,description-data)
|
||||
""))
|
||||
(if (assq-ref location-data 'base)
|
||||
(cons
|
||||
`(td ,(render-location
|
||||
base-git-repositories
|
||||
(assq-ref query-parameters 'base_commit)
|
||||
(assq-ref location-data 'base)))
|
||||
`(td ,(render-location
|
||||
target-git-repositories
|
||||
(assq-ref query-parameters 'target_commit)
|
||||
(assq-ref location-data 'target))))
|
||||
(cons
|
||||
`(td (@ (rowspan 2))
|
||||
,(render-location
|
||||
target-git-repositories
|
||||
(assq-ref query-parameters 'target_commit)
|
||||
location-data))
|
||||
""))
|
||||
(cons
|
||||
(let ((base-derivation (assq-ref derivation-data 'base)))
|
||||
`(td
|
||||
(a (@ (style "display: block;")
|
||||
(href ,base-derivation))
|
||||
(span (@ (class "text-danger glyphicon glyphicon-minus pull-left")
|
||||
(style "font-size: 1.5em; padding-right: 0.4em;")))
|
||||
,@(build-statuses->build-status-labels
|
||||
(vector->list (assq-ref builds-data 'base)))
|
||||
,(display-store-item-short base-derivation))))
|
||||
(let ((target-derivation (assq-ref derivation-data 'target)))
|
||||
`(td
|
||||
(a (@ (style "display: block;")
|
||||
(href ,target-derivation))
|
||||
(span (@ (class "text-success glyphicon glyphicon-plus pull-left")
|
||||
(style "font-size: 1.5em; padding-right: 0.4em;")))
|
||||
,@(build-statuses->build-status-labels
|
||||
(vector->list (assq-ref builds-data 'target)))
|
||||
,(display-store-item-short target-derivation)))))
|
||||
(cons
|
||||
`(td (@ (style "vertical-align: middle;")
|
||||
(rowspan 2))
|
||||
(a (@ (class "btn btn-sm btn-default")
|
||||
(title "Compare")
|
||||
(href
|
||||
,(string-append
|
||||
"/compare/derivation?"
|
||||
"base_derivation="
|
||||
(assq-ref derivation-data 'base)
|
||||
"&target_derivation="
|
||||
(assq-ref derivation-data 'target))))
|
||||
"⇕ Compare"))
|
||||
"")))
|
||||
|
||||
`((tr
|
||||
(td (@ (rowspan 2))
|
||||
,name)
|
||||
,@(map car cells))
|
||||
(tr
|
||||
,@(map cdr cells)))))
|
||||
changes))))))))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue