Christopher Baines
097e22ab5e
This means that the lock can be acquired after closing the inferior, freeing the large amount of memory that the inferior process is probably using.
117 lines
4.1 KiB
Scheme
117 lines
4.1 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
|
|
(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
|
|
(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))))))
|
|
#: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
|
|
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))
|
|
(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)))))
|
|
#:always-rollback? #t)))))
|
|
|
|
(test-end)
|