From 1a55022524043bdf2f120dd38990d42949ecb6e2 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Wed, 4 Sep 2019 19:28:48 +0200
Subject: Improve the package and package-metadata modules

Add tests around the package module, extract out the use of the
inferior-package record assessors so that they aren't part of the tests, and
switch across the package-metadata module to use
insert-missing-data-and-return-all-ids.
---
 tests/model-package.scm | 94 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 94 insertions(+)
 create mode 100644 tests/model-package.scm

(limited to 'tests')

diff --git a/tests/model-package.scm b/tests/model-package.scm
new file mode 100644
index 0000000..8029c3b
--- /dev/null
+++ b/tests/model-package.scm
@@ -0,0 +1,94 @@
+(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 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)
+  (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")))))
+
+   (inferior-packages->license-set-ids conn #f #f)))
+
+(define mock-inferior-packages
+  (list mock-inferior-package-foo
+        mock-inferior-package-foo-2))
+
+(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)
+      (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-inferior-packages
+                                        (test-license-set-ids conn))))
+             (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))
+               ((x) (number? x))))))
+       #:always-rollback? #t)
+
+      (with-postgresql-transaction
+       conn
+       (lambda (conn)
+         (let ((package-metadata-ids (inferior-packages->package-metadata-ids
+                                      conn
+                                      mock-inferior-packages
+                                      (test-license-set-ids conn))))
+           (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))
+             (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)))))
+       #:always-rollback? #t)))))
+
+(test-end)
-- 
cgit v1.2.3