aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--guix-data-service/jobs/load-new-guix-revision.scm8
-rw-r--r--guix-data-service/model/license-set.scm5
-rw-r--r--guix-data-service/model/license.scm8
-rw-r--r--tests/model-license-set.scm63
-rw-r--r--tests/model-license.scm64
-rw-r--r--tests/model-package-metadata.scm16
-rw-r--r--tests/model-package.scm16
7 files changed, 88 insertions, 92 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index b88b255..da58602 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -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
diff --git a/guix-data-service/model/license-set.scm b/guix-data-service/model/license-set.scm
index e88297c..7f23eaf 100644
--- a/guix-data-service/model/license-set.scm
+++ b/guix-data-service/model/license-set.scm
@@ -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
diff --git a/guix-data-service/model/license.scm b/guix-data-service/model/license.scm
index 0bf35f3..9104882 100644
--- a/guix-data-service/model/license.scm
+++ b/guix-data-service/model/license.scm
@@ -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
diff --git a/tests/model-license-set.scm b/tests/model-license-set.scm
index 62fd899..5c63b94 100644
--- a/tests/model-license-set.scm
+++ b/tests/model-license-set.scm
@@ -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)
diff --git a/tests/model-license.scm b/tests/model-license.scm
index 9e9d8b2..32b5623 100644
--- a/tests/model-license.scm
+++ b/tests/model-license.scm
@@ -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)
diff --git a/tests/model-package-metadata.scm b/tests/model-package-metadata.scm
index d80d6fd..81741b5 100644
--- a/tests/model-package-metadata.scm
+++ b/tests/model-package-metadata.scm
@@ -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 ()
diff --git a/tests/model-package.scm b/tests/model-package.scm
index 57a3142..0f2c796 100644
--- a/tests/model-package.scm
+++ b/tests/model-package.scm
@@ -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
generated by cgit v1.2.3 (git 2.45.0) at 2024-11-23 10:23:14 +0000