2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/data-service.git synced 2023-12-14 03:23:03 +01:00
data-service/tests/jobs-load-new-guix-revision.scm
Christopher Baines 3ba8418656 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.
2023-02-08 14:56:48 +00:00

212 lines
6.5 KiB
Scheme

(define-module (tests jobs-load-new-guix-revision)
#:use-module (srfi srfi-64)
#:use-module (ice-9 match)
#:use-module (squee)
#:use-module (guix utils)
#:use-module (guix store)
#:use-module (guix tests)
#:use-module (guix-data-service database)
#:use-module (guix-data-service model git-repository)
#:use-module (guix-data-service jobs load-new-guix-revision))
(test-begin "jobs-load-new-guix-revision")
(%daemon-socket-uri "/var/empty/doesnotexist")
(with-postgresql-connection
"test-jobs-load-new-guix-revision"
(lambda (conn)
(check-test-database! conn)
(exec-query conn "TRUNCATE guix_revisions CASCADE")
(test-equal "select-job-for-commit works"
#f
(select-job-for-commit conn "does not exist"))
(exec-query conn "TRUNCATE guix_revisions CASCADE")
(exec-query conn "TRUNCATE load_new_guix_revision_jobs CASCADE")
(test-equal "test job success"
#t
(mock
((guix-data-service jobs load-new-guix-revision)
with-store-connection
(lambda (f)
(f 'fake-store-connection)))
(mock
((guix-data-service jobs load-new-guix-revision)
channel->derivations-by-system
(lambda (conn store channel fetch-with-authentication?)
'(("x86_64-linux"
.
((manifest-entry-item . "/gnu/store/foo.drv")
(profile . "/gnu/store/bar.drv"))))))
(mock
((guix-data-service jobs load-new-guix-revision)
setup-logging
(lambda (conn thunk)
(thunk)))
(mock
((guix-data-service jobs load-new-guix-revision)
channel-derivations-by-system->guix-store-item
(lambda (store channel-derivations-by-system)
"/gnu/store/test"))
(mock
((guix-data-service jobs load-new-guix-revision)
extract-information-from
(lambda* (conn store guix-revision-id commit store-path
#:key skip-system-tests?)
#t))
(mock
((guix-data-service model channel-instance)
insert-channel-instances
(lambda (conn guix-revision-id derivations-by-system)
#t))
(mock
((guix channels)
channel-news-for-commit
(lambda (channel commit)
'()))
(match (enqueue-load-new-guix-revision-job
conn
(git-repository-url->git-repository-id conn "test-url")
"test-commit"
"test-source")
((id)
(process-load-new-guix-revision-job id)))))))))))
(exec-query conn "TRUNCATE guix_revisions CASCADE")
(exec-query conn "TRUNCATE load_new_guix_revision_jobs CASCADE")
(test-equal "test build store item failure"
#f
(mock
((guix-data-service jobs load-new-guix-revision)
with-store-connection
(lambda (f)
(f 'fake-store-connection)))
(mock
((guix-data-service jobs load-new-guix-revision)
channel->derivations-by-system
(lambda (conn store channel fetch-with-authentication?)
'(("x86_64-linux"
.
((manifest-entry-item . "/gnu/store/foo.drv")
(profile . "/gnu/store/bar.drv"))))))
(mock
((guix-data-service jobs load-new-guix-revision)
load-channel-instances
(lambda (git-repository-id commit
channel-derivations-by-system)
0))
(mock
((guix-data-service jobs load-new-guix-revision)
setup-logging
(lambda (conn thunk)
(thunk)))
(mock
((guix-data-service jobs load-new-guix-revision)
channel-derivations-by-system->guix-store-item
(lambda (store channel-derivations-by-system)
#f))
(match (enqueue-load-new-guix-revision-job
conn
(git-repository-url->git-repository-id conn "test-url")
"test-commit"
"test-source")
((id)
(process-load-new-guix-revision-job id)))))))))
(exec-query conn "TRUNCATE load_new_guix_revision_jobs CASCADE")
(test-equal "test extract information failure"
#f
(mock
((guix-data-service jobs load-new-guix-revision)
with-store-connection
(lambda (f)
(f 'fake-store-connection)))
(mock
((guix-data-service jobs load-new-guix-revision)
channel->derivations-by-system
(lambda (conn store channel fetch-with-authentication?)
'(("x86_64-linux"
.
((manifest-entry-item . "/gnu/store/foo.drv")
(profile . "/gnu/store/bar.drv"))))))
(mock
((guix-data-service jobs load-new-guix-revision)
load-channel-instances
(lambda (git-repository-id commit
channel-derivations-by-system)
0))
(mock
((guix-data-service jobs load-new-guix-revision)
setup-logging
(lambda (conn thunk)
(thunk)))
(mock
((guix-data-service jobs load-new-guix-revision)
channel-derivations-by-system->guix-store-item
(lambda (store channel-derivations-by-system)
"/gnu/store/test"))
(mock
((guix-data-service jobs load-new-guix-revision)
extract-information-from
(lambda* (conn store git-repository-id commit store-path
#:key skip-system-tests?)
#f))
(mock
((guix channels)
channel-news-for-commit
(lambda (channel commit)
'()))
(match (enqueue-load-new-guix-revision-job
conn
(git-repository-url->git-repository-id conn "test-url")
"test-commit"
"test-source")
((id)
(process-load-new-guix-revision-job id)))))))))))
(exec-query conn "TRUNCATE load_new_guix_revision_jobs CASCADE")
(test-assert "test duplicate job handling"
(with-postgresql-transaction
conn
(lambda (conn)
(enqueue-load-new-guix-revision-job
conn
(git-repository-url->git-repository-id conn "test-url")
"test-commit"
"test-source")
(enqueue-load-new-guix-revision-job
conn
(git-repository-url->git-repository-id conn "test-url")
"test-commit"
"test-source")
#t)
#:always-rollback? #t))))
(test-end)