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.

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