From 34a92e4c16a93a524f33a301bbc668c511cb5055 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 23 Feb 2020 22:22:59 +0000 Subject: 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. --- guix-data-service/jobs/load-new-guix-revision.scm | 8 ++- guix-data-service/model/license-set.scm | 5 +- guix-data-service/model/license.scm | 8 ++- tests/model-license-set.scm | 61 +++++++++++----------- tests/model-license.scm | 62 +++++++++++------------ 5 files changed, 70 insertions(+), 74 deletions(-) diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index 620a3a6..7001333 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -44,6 +44,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) @@ -639,8 +640,11 @@ WHERE job_id = $1" (let* ((package-license-set-ids (log-time "fetching inferior package license metadata" (lambda () - (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 (log-time "fetching inferior package metadata" (lambda () 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 c39171f..efd67b6 100644 --- a/tests/model-license-set.scm +++ b/tests/model-license-set.scm @@ -3,43 +3,44 @@ #: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) - (with-postgresql-transaction - conn - (lambda (conn) - (test-assert "works" - (inferior-packages->license-set-ids conn #f #f))) - #:always-rollback? #t) +(with-postgresql-connection + "test-model-license-set" + (lambda (conn) + (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 8f4b0c3..ea7f109 100644 --- a/tests/model-license.scm +++ b/tests/model-license.scm @@ -3,44 +3,40 @@ #: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) - (with-postgresql-transaction - conn - (lambda (conn) - (test-assert "works" - (inferior-packages->license-id-lists conn #f #f))) - #:always-rollback? #t) +(with-postgresql-connection + "test-model-license" + (lambda (conn) + (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) -- cgit v1.2.3