[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
branch master updated: Allow skipping processing system tests
From: |
Christopher Baines |
Subject: |
branch master updated: Allow skipping processing system tests |
Date: |
Wed, 08 Feb 2023 09:57:33 -0500 |
This is an automated email from the git hooks/post-receive script.
cbaines pushed a commit to branch master
in repository data-service.
The following commit(s) were added to refs/heads/master by this push:
new 3ba8418 Allow skipping processing system tests
3ba8418 is described below
commit 3ba841865663429392f869aedcd8f1fb63f278db
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Wed Feb 8 13:23:41 2023 +0100
Allow skipping processing system tests
Generating system test derivations are difficult, since you generally need
to
do potentially expensive builds for the system you're generating the system
tests for. You might not want to disable grafts for instance because you
might
be trying to test whatever the test is testing in the context of grafts
being
enabled.
I'm looking at skipping the system tests on data.guix.gnu.org, because
they're
not used and quite expensive to compute.
---
guix-data-service/jobs.scm | 13 +++++++---
guix-data-service/jobs/load-new-guix-revision.scm | 24 ++++++++++++------
scripts/guix-data-service-process-job.in | 30 ++++++++++++++++++++---
scripts/guix-data-service-process-jobs.in | 9 +++++--
tests/jobs-load-new-guix-revision.scm | 6 +++--
5 files changed, 64 insertions(+), 18 deletions(-)
diff --git a/guix-data-service/jobs.scm b/guix-data-service/jobs.scm
index 8945e43..56c3ce7 100644
--- a/guix-data-service/jobs.scm
+++ b/guix-data-service/jobs.scm
@@ -26,14 +26,19 @@
default-max-processes))
(define* (process-jobs conn #:key max-processes
- latest-branch-revision-max-processes)
+ latest-branch-revision-max-processes
+ skip-system-tests?)
(define (fetch-new-jobs)
(fetch-unlocked-jobs conn))
(define (process-job job-id)
- (execlp "guix-data-service-process-job"
- "guix-data-service-process-job"
- job-id))
+ (apply execlp
+ "guix-data-service-process-job"
+ "guix-data-service-process-job"
+ job-id
+ (if skip-system-tests?
+ '("--skip-system-tests")
+ '())))
(define (handle-job-failure job-id)
(record-job-event conn job-id "failure")
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm
b/guix-data-service/jobs/load-new-guix-revision.scm
index 57d6e77..a44c675 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -1473,7 +1473,8 @@ WHERE job_id = $1")
inf))
-(define (extract-information-from conn store guix-revision-id commit
store-path)
+(define* (extract-information-from conn store guix-revision-id commit
store-path
+ #:key skip-system-tests?)
(simple-format #t "debug: extract-information-from: ~A\n" store-path)
(let ((inf (start-inferior-for-data-extration store store-path)))
@@ -1490,8 +1491,12 @@ WHERE job_id = $1")
(with-time-logging "getting inferior derivations"
(all-inferior-package-derivations store inf packages)))
(inferior-system-tests
- (with-time-logging "getting inferior system tests"
- (all-inferior-system-tests inf store)))
+ (if skip-system-tests?
+ (begin
+ (simple-format #t "debug: skipping system tests\n")
+ '())
+ (with-time-logging "getting inferior system tests"
+ (all-inferior-system-tests inf store))))
(packages-data
(with-time-logging "getting all inferior package data"
(all-inferior-packages-data inf packages))))
@@ -1636,7 +1641,8 @@ WHERE job_id = $1")
(prevent-inlining-for-tests load-channel-instances)
-(define (load-new-guix-revision conn store git-repository-id commit)
+(define* (load-new-guix-revision conn store git-repository-id commit
+ #:key skip-system-tests?)
(let* ((git-repository-fields
(select-git-repository conn git-repository-id))
(git-repository-url
@@ -1663,7 +1669,9 @@ WHERE job_id = $1")
(and
(extract-information-from conn store
guix-revision-id
- commit store-item)
+ commit store-item
+ #:skip-system-tests?
+ skip-system-tests?)
(if (defined? 'channel-news-for-commit
(resolve-module '(guix channels)))
@@ -2082,7 +2090,7 @@ SKIP LOCKED")
(prevent-inlining-for-tests setup-logging)
-(define (process-load-new-guix-revision-job id)
+(define* (process-load-new-guix-revision-job id #:key skip-system-tests?)
(with-postgresql-connection
(simple-format #f "load-new-guix-revision ~A" id)
(lambda (conn)
@@ -2121,7 +2129,9 @@ SKIP LOCKED")
(load-new-guix-revision conn
store
git-repository-id
- commit))))
+ commit
+ #:skip-system-tests?
+ skip-system-tests?))))
(lambda (key . args)
(simple-format (current-error-port)
"error: load-new-guix-revision: ~A
~A\n"
diff --git a/scripts/guix-data-service-process-job.in
b/scripts/guix-data-service-process-job.in
index e67e4e2..c6d06c6 100644
--- a/scripts/guix-data-service-process-job.in
+++ b/scripts/guix-data-service-process-job.in
@@ -38,6 +38,30 @@
;; Make stack traces more useful
(setenv "COLUMNS" "256")
-(match (command-line)
- ((name job)
- (process-load-new-guix-revision-job job)))
+(define %options
+ (list (option '("skip-system-tests") #f #f
+ (lambda (opt name _ result)
+ (alist-cons 'skip-system-tests #t result)))))
+
+(define %default-options '())
+
+(define (parse-options args)
+ (args-fold
+ args %options
+ (lambda (opt name arg result)
+ (error "unrecognized option" name))
+ (lambda (arg result)
+ (alist-cons
+ 'arguments
+ (cons arg
+ (or (assoc-ref result 'arguments)
+ '()))
+ (alist-delete 'arguments result)))
+ %default-options))
+
+(let ((opts (parse-options (cdr (program-arguments)))))
+ (match (assq-ref opts 'arguments)
+ ((job)
+ (process-load-new-guix-revision-job
+ job
+ #:skip-system-tests? (assq-ref opts 'skip-system-tests)))))
diff --git a/scripts/guix-data-service-process-jobs.in
b/scripts/guix-data-service-process-jobs.in
index 4a7af52..fb0385e 100644
--- a/scripts/guix-data-service-process-jobs.in
+++ b/scripts/guix-data-service-process-jobs.in
@@ -41,7 +41,10 @@
(lambda (opt name arg result)
(alist-cons 'latest-branch-revision-max-processes
(string->number arg)
- result)))))
+ result)))
+ (option '("skip-system-tests") #f #f
+ (lambda (opt name _ result)
+ (alist-cons 'skip-system-tests #t result)))))
(define %default-options
;; Alist of default option values
@@ -70,4 +73,6 @@
#:max-processes (assq-ref opts 'max-processes)
#:latest-branch-revision-max-processes
(or (assq-ref opts 'latest-branch-revision-max-processes)
- (* 2 (assq-ref opts 'max-processes)))))))
+ (* 2 (assq-ref opts 'max-processes)))
+ #:skip-system-tests?
+ (assq-ref opts 'skip-system-tests)))))
diff --git a/tests/jobs-load-new-guix-revision.scm
b/tests/jobs-load-new-guix-revision.scm
index b70d702..0f40e52 100644
--- a/tests/jobs-load-new-guix-revision.scm
+++ b/tests/jobs-load-new-guix-revision.scm
@@ -59,7 +59,8 @@
(mock
((guix-data-service jobs load-new-guix-revision)
extract-information-from
- (lambda (conn store guix-revision-id commit store-path)
+ (lambda* (conn store guix-revision-id commit store-path
+ #:key skip-system-tests?)
#t))
(mock
@@ -170,7 +171,8 @@
(mock
((guix-data-service jobs load-new-guix-revision)
extract-information-from
- (lambda (conn store git-repository-id commit store-path)
+ (lambda* (conn store git-repository-id commit store-path
+ #:key skip-system-tests?)
#f))
(mock
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- branch master updated: Allow skipping processing system tests,
Christopher Baines <=