aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/jobs-load-new-guix-revision.scm142
-rw-r--r--tests/model-git-branch.scm2
-rw-r--r--tests/model-git-commit.scm4
-rw-r--r--tests/model-git-repository.scm2
-rw-r--r--tests/model-license-set.scm18
-rw-r--r--tests/model-license.scm24
-rw-r--r--tests/model-lint-checker.scm37
-rw-r--r--tests/model-lint-warning-message.scm12
-rw-r--r--tests/model-package-metadata.scm27
-rw-r--r--tests/model-package.scm54
10 files changed, 113 insertions, 209 deletions
diff --git a/tests/jobs-load-new-guix-revision.scm b/tests/jobs-load-new-guix-revision.scm
index 1a64ce3..64f2464 100644
--- a/tests/jobs-load-new-guix-revision.scm
+++ b/tests/jobs-load-new-guix-revision.scm
@@ -2,6 +2,7 @@
#:use-module (srfi srfi-64)
#:use-module (ice-9 match)
#:use-module (squee)
+ #:use-module (fibers)
#:use-module (guix utils)
#:use-module (guix store)
#:use-module (guix tests)
@@ -44,9 +45,9 @@
(mock
((guix-data-service jobs load-new-guix-revision)
channel->source-and-derivations-by-system
- (lambda* (conn store channel fetch-with-authentication?
- #:key parallelism)
- (cons
+ (lambda* (conn channel fetch-with-authentication?
+ #:key parallelism ignore-systems)
+ (values
"/gnu/store/guix"
'(("x86_64-linux"
.
@@ -56,16 +57,14 @@
(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"))
+ (lambda (channel-derivations-by-system)
+ (values "/gnu/store/test"
+ "/gnu/store/test.drv")))
(mock
((guix-data-service jobs load-new-guix-revision)
extract-information-from
- (lambda* (conn store guix-revision-id commit
- guix-source store-path
- #:key skip-system-tests?
- parallelism)
+ (lambda _
#t))
(mock
@@ -80,6 +79,12 @@
(lambda (channel commit)
'()))
+ (mock
+ ((guix-data-service jobs load-new-guix-revision)
+ derivation-file-names->derivation-ids
+ (lambda _
+ #(1)))
+
(mock
((guix store)
add-temp-root
@@ -92,125 +97,20 @@
(match (enqueue-load-new-guix-revision-job
conn
- (git-repository-url->git-repository-id conn "test-url")
+ (git-repository-url->git-repository-id conn "test-url3")
"test-commit"
"test-source")
((id)
- (process-load-new-guix-revision-job id)))))))))))))
+ (run-fibers
+ (lambda ()
+ (process-load-new-guix-revision-job
+ id #:parallelism 1))
+ #:hz 0
+ #:parallelism 1))))))))))))))
(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->source-and-derivations-by-system
- (lambda (conn store channel fetch-with-authentication?)
- (cons
- "/gnu/store/guix"
- '(("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->source-and-derivations-by-system
- (lambda (conn store channel fetch-with-authentication?)
- (cons
- "/gnu/store/guix"
- '(("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
- guix-source 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
diff --git a/tests/model-git-branch.scm b/tests/model-git-branch.scm
index 1bcc1c3..5c2dfe8 100644
--- a/tests/model-git-branch.scm
+++ b/tests/model-git-branch.scm
@@ -16,7 +16,7 @@
(with-postgresql-transaction
conn
(lambda (conn)
- (let* ((url "test-url")
+ (let* ((url "test-url4")
(git-repository-id
(git-repository-url->git-repository-id conn url)))
(insert-git-branch-entry conn git-repository-id "master")
diff --git a/tests/model-git-commit.scm b/tests/model-git-commit.scm
index b8bc3d8..ef4f535 100644
--- a/tests/model-git-commit.scm
+++ b/tests/model-git-commit.scm
@@ -17,7 +17,7 @@
(with-postgresql-transaction
conn
(lambda (conn)
- (let* ((url "test-url")
+ (let* ((url "test-url5")
(git-repository-id
(git-repository-url->git-repository-id conn url))
(git-branch-id
@@ -33,7 +33,7 @@
(with-postgresql-transaction
conn
(lambda (conn)
- (let* ((url "test-url")
+ (let* ((url "test-url2")
(git-repository-id
(git-repository-url->git-repository-id conn url))
(git-branch-id
diff --git a/tests/model-git-repository.scm b/tests/model-git-repository.scm
index ca43c59..8f40778 100644
--- a/tests/model-git-repository.scm
+++ b/tests/model-git-repository.scm
@@ -22,7 +22,7 @@
#t)))
#:always-rollback? #t))
- (let* ((url "test-url")
+ (let* ((url "test-url6")
(id (git-repository-url->git-repository-id conn url)))
(with-postgresql-transaction
conn
diff --git a/tests/model-license-set.scm b/tests/model-license-set.scm
index 1b377b7..38a86de 100644
--- a/tests/model-license-set.scm
+++ b/tests/model-license-set.scm
@@ -9,15 +9,15 @@
(test-begin "test-model-license-set")
(define license-data
- '((("License 1"
- "https://gnu.org/licenses/test-1.html"
- "https://example.com/why-license-1"))
- (("License 1"
- "https://gnu.org/licenses/test-1.html"
- #f)
- ("License 2"
- #f
- #f))))
+ '#((("License 1"
+ "https://gnu.org/licenses/test-1.html"
+ "https://example.com/why-license-1"))
+ (("License 1"
+ "https://gnu.org/licenses/test-1.html"
+ #f)
+ ("License 2"
+ #f
+ #f))))
(with-postgresql-connection
"test-model-license-set"
diff --git a/tests/model-license.scm b/tests/model-license.scm
index 32b5623..e34b4f8 100644
--- a/tests/model-license.scm
+++ b/tests/model-license.scm
@@ -8,18 +8,18 @@
(test-begin "test-model-license")
(define license-data
- '((("License 1"
- "https://gnu.org/licenses/test-1.html"
- "https://example.com/why-license-1"))
- (("License 1"
- "https://gnu.org/licenses/test-1.html"
- #f)
- ("License 2"
- "https://gnu.org/licenses/test-2.html"
- #f)
- ("License 3"
- #f
- #f))))
+ '#((("License 1"
+ "https://gnu.org/licenses/test-1.html"
+ "https://example.com/why-license-1"))
+ (("License 1"
+ "https://gnu.org/licenses/test-1.html"
+ #f)
+ ("License 2"
+ "https://gnu.org/licenses/test-2.html"
+ #f)
+ ("License 3"
+ #f
+ #f))))
(with-postgresql-connection
"test-model-license"
diff --git a/tests/model-lint-checker.scm b/tests/model-lint-checker.scm
index e6740b1..73ac405 100644
--- a/tests/model-lint-checker.scm
+++ b/tests/model-lint-checker.scm
@@ -16,32 +16,23 @@
conn
(lambda (conn)
(define data
- `((name-1 #t ,(string->number (insert-lint-checker-description-set
- conn '(37))))
- (name-2 #f ,(string->number (insert-lint-checker-description-set
- conn '(38))))))
+ `#((name-1
+ #t
+ ,(lint-checker-description-data->lint-checker-description-set-id
+ conn
+ '(("en_US" . "foo"))))
+ (name-2
+ #f
+ ,(lint-checker-description-data->lint-checker-description-set-id
+ conn
+ '(("en_US" . "bar"))))))
(match (lint-checkers->lint-checker-ids conn data)
- (((? number? id1) (? number? id2))
- #t)))
- #:always-rollback? #t))
-
- (test-assert "double insert"
- (with-postgresql-transaction
- conn
- (lambda (conn)
- (define data
- `((name-1 #t ,(string->number (insert-lint-checker-description-set
- conn '(37))))
- (name-2 #f ,(string->number (insert-lint-checker-description-set
- conn '(38))))))
-
- (match (lint-checkers->lint-checker-ids conn data)
- (((? number? id1) (? number? id2))
+ (#((? number? id1) (? number? id2))
(match (lint-checkers->lint-checker-ids conn data)
- (((? number? second-id1) (? number? second-id2))
- (and (eq? id1 second-id1)
- (eq? id2 second-id2)))))))
+ (#((? number? second-id1) (? number? second-id2))
+ (and (= id1 second-id1)
+ (= id2 second-id2)))))))
#:always-rollback? #t))))
(test-end)
diff --git a/tests/model-lint-warning-message.scm b/tests/model-lint-warning-message.scm
index 7231a34..88cedd1 100644
--- a/tests/model-lint-warning-message.scm
+++ b/tests/model-lint-warning-message.scm
@@ -20,7 +20,7 @@
conn
(lambda (conn)
(match (lint-warning-message-data->lint-warning-message-ids conn data)
- (((? number? id1) (? number? id2))
+ (#((? number? id1) (? number? id2))
#t)))
#:always-rollback? #t))
@@ -29,11 +29,11 @@
conn
(lambda (conn)
(match (lint-warning-message-data->lint-warning-message-ids conn data)
- (((? number? id1) (? number? id2))
+ (#((? number? id1) (? number? id2))
(match (lint-warning-message-data->lint-warning-message-ids conn data)
- (((? number? second-id1) (? number? second-id2))
- (and (eq? id1 second-id1)
- (eq? id2 second-id2)))))))
+ (#((? number? second-id1) (? number? second-id2))
+ (and (= id1 second-id1)
+ (= id2 second-id2)))))))
#:always-rollback? #t))
(test-assert "single set insert"
@@ -53,7 +53,7 @@
((? number? id)
(match (lint-warning-message-data->lint-warning-message-set-id conn data)
((? number? second-id)
- (eq? id second-id))))))
+ (= id second-id))))))
#:always-rollback? #t))))
(test-end)
diff --git a/tests/model-package-metadata.scm b/tests/model-package-metadata.scm
index 407b7d2..5e9c897 100644
--- a/tests/model-package-metadata.scm
+++ b/tests/model-package-metadata.scm
@@ -34,21 +34,25 @@
mock-inferior-package-foo-2))
(define mock-package-metadata
- (map (lambda (mock-inf-pkg)
- (list
- (mock-inferior-package-home-page mock-inf-pkg)
- (mock-inferior-package-location mock-inf-pkg)
- `(("en_US.UTF-8" . "Fake synopsis"))
- `(("en_US.UTF-8" . "Fake description"))))
- mock-inferior-packages))
+ (list->vector
+ (map (lambda (mock-inf-pkg)
+ (list
+ (mock-inferior-package-home-page mock-inf-pkg)
+ (mock-inferior-package-location mock-inf-pkg)
+ `(("en_US.UTF-8" . "Fake synopsis"))
+ `(("en_US.UTF-8" . "Fake description"))))
+ mock-inferior-packages)))
(define (test-license-set-ids conn)
(let ((license-id-lists
(inferior-packages->license-id-lists
conn
- '((("License 1"
- "https://gnu.org/licenses/test-1.html"
- "https://example.com/why-license-1"))))))
+ '#((("License 1"
+ "https://gnu.org/licenses/test-1.html"
+ "https://example.com/why-license-1"))
+ (("License 1"
+ "https://gnu.org/licenses/test-1.html"
+ "https://example.com/why-license-1"))))))
(inferior-packages->license-set-ids conn license-id-lists)))
@@ -73,7 +77,8 @@
conn
mock-package-metadata
(test-license-set-ids conn))
- ((x) (number? x))))
+ (#(x y) (and (number? x)
+ (number? y)))))
#:always-rollback? #t))
(with-postgresql-transaction
diff --git a/tests/model-package.scm b/tests/model-package.scm
index bf2cf71..f58b887 100644
--- a/tests/model-package.scm
+++ b/tests/model-package.scm
@@ -36,9 +36,12 @@
(let ((license-id-lists
(inferior-packages->license-id-lists
conn
- '((("License 1"
- "https://gnu.org/licenses/test-1.html"
- "https://example.com/why-license-1"))))))
+ '#((("License 1"
+ "https://gnu.org/licenses/test-1.html"
+ "https://example.com/why-license-1"))
+ (("License 1"
+ "https://gnu.org/licenses/test-1.html"
+ "https://example.com/why-license-1"))))))
(inferior-packages->license-set-ids conn license-id-lists)))
@@ -47,13 +50,14 @@
mock-inferior-package-foo-2))
(define mock-package-metadata
- (map (lambda (mock-inf-pkg)
- (list
- (mock-inferior-package-home-page mock-inf-pkg)
- (mock-inferior-package-location mock-inf-pkg)
- `(("en_US.UTF-8" . "Fake synopsis"))
- `(("en_US.UTF-8" . "Fake description"))))
- mock-inferior-packages))
+ (list->vector
+ (map (lambda (mock-inf-pkg)
+ (list
+ (mock-inferior-package-home-page mock-inf-pkg)
+ (mock-inferior-package-location mock-inf-pkg)
+ `(("en_US.UTF-8" . "Fake synopsis"))
+ `(("en_US.UTF-8" . "Fake description"))))
+ mock-inferior-packages)))
(with-mock-inferior-packages
(lambda ()
@@ -81,11 +85,13 @@
(cons "integer" NULL))))
(match (inferior-packages->package-ids
conn
- (zip (map mock-inferior-package-name mock-inferior-packages)
- (map mock-inferior-package-version mock-inferior-packages)
- package-metadata-ids
- package-replacement-package-ids))
- ((x) (number? x))))))
+ (list->vector
+ (zip (map mock-inferior-package-name mock-inferior-packages)
+ (map mock-inferior-package-version mock-inferior-packages)
+ (vector->list package-metadata-ids)
+ package-replacement-package-ids)))
+ (#(x y) (and (number? x)
+ (number? y)))))))
#:always-rollback? #t)
(with-postgresql-transaction
@@ -102,16 +108,18 @@
(test-equal "inferior-packages->package-ids is idempotent"
(inferior-packages->package-ids
conn
- (zip (map mock-inferior-package-name mock-inferior-packages)
- (map mock-inferior-package-version mock-inferior-packages)
- package-metadata-ids
- package-replacement-package-ids))
+ (list->vector
+ (zip (map mock-inferior-package-name mock-inferior-packages)
+ (map mock-inferior-package-version mock-inferior-packages)
+ (vector->list package-metadata-ids)
+ package-replacement-package-ids)))
(inferior-packages->package-ids
conn
- (zip (map mock-inferior-package-name mock-inferior-packages)
- (map mock-inferior-package-version mock-inferior-packages)
- package-metadata-ids
- package-replacement-package-ids)))))
+ (list->vector
+ (zip (map mock-inferior-package-name mock-inferior-packages)
+ (map mock-inferior-package-version mock-inferior-packages)
+ (vector->list package-metadata-ids)
+ package-replacement-package-ids))))))
#:always-rollback? #t)))))
(test-end)
generated by cgit v1.2.3 (git 2.49.0) at 2025-07-07 01:27:48 +0000