Adapt some license related code to work without mock in the tests
With Guile 3, there's a potential for mock to work in even fewer circumstances. So, adapt the code to enable writing the tests without mock.
This commit is contained in:
parent
ce10833459
commit
2f41fe79be
|
@ -45,6 +45,7 @@
|
|||
#:use-module (guix-data-service model guix-revision)
|
||||
#:use-module (guix-data-service model package-derivation)
|
||||
#:use-module (guix-data-service model guix-revision-package-derivation)
|
||||
#:use-module (guix-data-service model license)
|
||||
#:use-module (guix-data-service model license-set)
|
||||
#:use-module (guix-data-service model lint-checker)
|
||||
#:use-module (guix-data-service model lint-warning)
|
||||
|
@ -626,8 +627,11 @@ WHERE job_id = $1"
|
|||
(define (insert-packages conn inf packages)
|
||||
(let* ((package-license-set-ids
|
||||
(with-time-logging "fetching inferior package license metadata"
|
||||
(inferior-packages->license-set-ids conn inf
|
||||
packages)))
|
||||
(inferior-packages->license-set-ids
|
||||
conn
|
||||
(inferior-packages->license-id-lists
|
||||
conn
|
||||
(inferior-packages->license-data inf packages)))))
|
||||
(packages-metadata-ids
|
||||
(with-time-logging "fetching inferior package metadata"
|
||||
(inferior-packages->package-metadata-ids
|
||||
|
|
|
@ -44,10 +44,7 @@ FROM license_sets")
|
|||
", ")
|
||||
" RETURNING id"))
|
||||
|
||||
(define (inferior-packages->license-set-ids conn inf packages)
|
||||
(define license-id-lists
|
||||
(inferior-packages->license-id-lists conn inf packages))
|
||||
|
||||
(define (inferior-packages->license-set-ids conn license-id-lists)
|
||||
(let* ((unique-license-id-lists (delete-duplicates
|
||||
license-id-lists))
|
||||
(existing-license-sets
|
||||
|
|
|
@ -22,7 +22,8 @@
|
|||
#:use-module (squee)
|
||||
#:use-module (guix inferior)
|
||||
#:use-module (guix-data-service model utils)
|
||||
#:export (inferior-packages->license-id-lists))
|
||||
#:export (inferior-packages->license-id-lists
|
||||
inferior-packages->license-data))
|
||||
|
||||
(define inferior-package-id
|
||||
(@@ (guix inferior) inferior-package-id))
|
||||
|
@ -61,10 +62,7 @@
|
|||
(inferior-eval '(use-modules (guix licenses)) inf)
|
||||
(inferior-eval (proc packages) inf))
|
||||
|
||||
(define (inferior-packages->license-id-lists conn inf packages)
|
||||
(define license-data
|
||||
(inferior-packages->license-data inf packages))
|
||||
|
||||
(define (inferior-packages->license-id-lists conn license-data)
|
||||
(define (string-or-null v)
|
||||
(if (string? v)
|
||||
v
|
||||
|
|
|
@ -3,45 +3,46 @@
|
|||
#:use-module (guix utils)
|
||||
#:use-module (guix tests)
|
||||
#:use-module (guix-data-service database)
|
||||
#:use-module (tests mock-inferior)
|
||||
#:use-module (guix-data-service model license)
|
||||
#:use-module (guix-data-service model license-set))
|
||||
|
||||
(use-modules (tests driver))
|
||||
|
||||
(test-begin "test-model-license-set")
|
||||
|
||||
(mock
|
||||
((guix-data-service model license)
|
||||
inferior-packages->license-data
|
||||
(lambda (inf packages)
|
||||
'((("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)))))
|
||||
(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))))
|
||||
|
||||
(with-postgresql-connection
|
||||
"test-model-license-set"
|
||||
(lambda (conn)
|
||||
(check-test-database! conn)
|
||||
(with-postgresql-connection
|
||||
"test-model-license-set"
|
||||
(lambda (conn)
|
||||
(check-test-database! conn)
|
||||
|
||||
(with-postgresql-transaction
|
||||
conn
|
||||
(lambda (conn)
|
||||
(test-assert "works"
|
||||
(inferior-packages->license-set-ids conn #f #f)))
|
||||
#:always-rollback? #t)
|
||||
(with-postgresql-transaction
|
||||
conn
|
||||
(lambda (conn)
|
||||
(test-assert "works"
|
||||
(inferior-packages->license-set-ids
|
||||
conn
|
||||
(inferior-packages->license-id-lists conn license-data))))
|
||||
#:always-rollback? #t)
|
||||
|
||||
(with-postgresql-transaction
|
||||
conn
|
||||
(lambda (conn)
|
||||
(test-equal "works repeatedly"
|
||||
(inferior-packages->license-set-ids conn #f #f)
|
||||
(inferior-packages->license-set-ids conn #f #f)))
|
||||
#:always-rollback? #t))))
|
||||
(with-postgresql-transaction
|
||||
conn
|
||||
(lambda (conn)
|
||||
(let ((license-id-lists
|
||||
(inferior-packages->license-id-lists conn license-data)))
|
||||
(test-equal "works repeatedly"
|
||||
(inferior-packages->license-set-ids conn license-id-lists)
|
||||
(inferior-packages->license-set-ids conn license-id-lists))))
|
||||
#:always-rollback? #t)))
|
||||
|
||||
(test-end)
|
||||
|
|
|
@ -3,46 +3,42 @@
|
|||
#:use-module (guix utils)
|
||||
#:use-module (guix tests)
|
||||
#:use-module (guix-data-service database)
|
||||
#:use-module (tests mock-inferior)
|
||||
#:use-module (guix-data-service model license))
|
||||
|
||||
(test-begin "test-model-license")
|
||||
|
||||
(mock
|
||||
((guix-data-service model license)
|
||||
inferior-packages->license-data
|
||||
(lambda (inf packages)
|
||||
'((("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)))))
|
||||
(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))))
|
||||
|
||||
(with-postgresql-connection
|
||||
"test-model-license"
|
||||
(lambda (conn)
|
||||
(check-test-database! conn)
|
||||
(with-postgresql-connection
|
||||
"test-model-license"
|
||||
(lambda (conn)
|
||||
(check-test-database! conn)
|
||||
|
||||
(with-postgresql-transaction
|
||||
conn
|
||||
(lambda (conn)
|
||||
(test-assert "works"
|
||||
(inferior-packages->license-id-lists conn #f #f)))
|
||||
#:always-rollback? #t)
|
||||
(with-postgresql-transaction
|
||||
conn
|
||||
(lambda (conn)
|
||||
(test-assert "works"
|
||||
(inferior-packages->license-id-lists conn license-data)))
|
||||
#:always-rollback? #t)
|
||||
|
||||
(with-postgresql-transaction
|
||||
conn
|
||||
(lambda (conn)
|
||||
(test-equal "works repeatedly"
|
||||
(inferior-packages->license-id-lists conn #f #f)
|
||||
(inferior-packages->license-id-lists conn #f #f)))
|
||||
#:always-rollback? #t))))
|
||||
(with-postgresql-transaction
|
||||
conn
|
||||
(lambda (conn)
|
||||
(test-equal "works repeatedly"
|
||||
(inferior-packages->license-id-lists conn license-data)
|
||||
(inferior-packages->license-id-lists conn license-data)))
|
||||
#:always-rollback? #t)))
|
||||
|
||||
(test-end)
|
||||
|
|
|
@ -4,6 +4,7 @@
|
|||
#:use-module (guix utils)
|
||||
#:use-module (guix tests)
|
||||
#:use-module (tests mock-inferior)
|
||||
#:use-module (guix-data-service model license)
|
||||
#:use-module (guix-data-service model license-set)
|
||||
#:use-module (guix-data-service database))
|
||||
|
||||
|
@ -28,15 +29,14 @@
|
|||
(location #f)))
|
||||
|
||||
(define (test-license-set-ids conn)
|
||||
(mock
|
||||
((guix-data-service model license)
|
||||
inferior-packages->license-data
|
||||
(lambda (inf packages)
|
||||
'((("License 1"
|
||||
"https://gnu.org/licenses/test-1.html"
|
||||
"https://example.com/why-license-1")))))
|
||||
(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 #f #f)))
|
||||
(inferior-packages->license-set-ids conn license-id-lists)))
|
||||
|
||||
(with-mock-inferior-packages
|
||||
(lambda ()
|
||||
|
|
|
@ -5,6 +5,7 @@
|
|||
#:use-module (guix utils)
|
||||
#:use-module (guix tests)
|
||||
#:use-module (tests mock-inferior)
|
||||
#: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)
|
||||
|
@ -31,15 +32,14 @@
|
|||
(location #f)))
|
||||
|
||||
(define (test-license-set-ids conn)
|
||||
(mock
|
||||
((guix-data-service model license)
|
||||
inferior-packages->license-data
|
||||
(lambda (inf packages)
|
||||
'((("License 1"
|
||||
"https://gnu.org/licenses/test-1.html"
|
||||
"https://example.com/why-license-1")))))
|
||||
(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 #f #f)))
|
||||
(inferior-packages->license-set-ids conn license-id-lists)))
|
||||
|
||||
(define mock-inferior-packages
|
||||
(list mock-inferior-package-foo
|
||||
|
|
Loading…
Reference in New Issue