Christopher Baines
5ed98343d7
These changes were motivated by switching to a mechanism of loading data that isn't dependent on the big advisory lock that prevents more than one revision from being processed at a time. Since INSERT ... RETURNING id; is used, this can block if another transaction inserts the same data, and then cause an error when that transaction commits. The solution is to use ON CONFLICT DO NOTHING, but you have to handle the case when the INSERT doesn't return an id since the other transaction has inserted it. This commit rewrites insert-missing-data-and-return-all-ids to do as described above, as well as being more efficient in how existing data is detected and to use more vectors. Other utilities for inserting data are added as well.
121 lines
4.3 KiB
Scheme
121 lines
4.3 KiB
Scheme
(define-module (test-model-package)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-64)
|
|
#:use-module (guix utils)
|
|
#:use-module (guix tests)
|
|
#:use-module (tests mock-inferior)
|
|
#:use-module (guix-data-service model utils)
|
|
#:use-module (guix-data-service model license)
|
|
#:use-module (guix-data-service model license-set)
|
|
#:use-module (guix-data-service model package)
|
|
#:use-module (guix-data-service model package-metadata)
|
|
#:use-module (guix-data-service database))
|
|
|
|
(test-begin "test-model-package")
|
|
|
|
(define mock-inferior-package-foo
|
|
(mock-inferior-package
|
|
(name "foo")
|
|
(version "2")
|
|
(synopsis "Foo")
|
|
(description "Foo description")
|
|
(home-page "https://example.com")
|
|
(location (location "file.scm" 5 0))))
|
|
|
|
(define mock-inferior-package-foo-2
|
|
(mock-inferior-package
|
|
(name "foo")
|
|
(version "2")
|
|
(synopsis "Foo")
|
|
(description "Foo description")
|
|
(home-page #f)
|
|
(location #f)))
|
|
|
|
(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"))))))
|
|
|
|
(inferior-packages->license-set-ids conn license-id-lists)))
|
|
|
|
(define mock-inferior-packages
|
|
(list mock-inferior-package-foo
|
|
mock-inferior-package-foo-2))
|
|
|
|
(define mock-package-metadata
|
|
(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 ()
|
|
(use-modules (guix-data-service model package)
|
|
(guix-data-service model git-repository)
|
|
(guix-data-service model guix-revision)
|
|
(guix-data-service model package-metadata))
|
|
|
|
(with-postgresql-connection
|
|
"test-model-package"
|
|
(lambda (conn)
|
|
(check-test-database! conn)
|
|
|
|
(with-postgresql-transaction
|
|
conn
|
|
(lambda (conn)
|
|
(test-assert "inferior-packages->package-ids works once"
|
|
(let ((package-metadata-ids
|
|
(inferior-packages->package-metadata-ids
|
|
conn
|
|
mock-package-metadata
|
|
(test-license-set-ids conn)))
|
|
(package-replacement-package-ids
|
|
(make-list (length mock-inferior-packages)
|
|
(cons "integer" NULL))))
|
|
(match (inferior-packages->package-ids
|
|
conn
|
|
(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) (number? x))))))
|
|
#:always-rollback? #t)
|
|
|
|
(with-postgresql-transaction
|
|
conn
|
|
(lambda (conn)
|
|
(let ((package-metadata-ids
|
|
(inferior-packages->package-metadata-ids
|
|
conn
|
|
mock-package-metadata
|
|
(test-license-set-ids conn)))
|
|
(package-replacement-package-ids
|
|
(make-list (length mock-inferior-packages)
|
|
(cons "integer" NULL))))
|
|
(test-equal "inferior-packages->package-ids is idempotent"
|
|
(inferior-packages->package-ids
|
|
conn
|
|
(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
|
|
(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)
|