From 097e22ab5e8c59b0ffce1867a54eb0622ab75ce4 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 11 Mar 2022 13:07:34 +0000 Subject: Close the load revision inferior prior to inserting data This means that the lock can be acquired after closing the inferior, freeing the large amount of memory that the inferior process is probably using. --- tests/model-package-metadata.scm | 93 ++++++++++++++++++++-------------------- tests/model-package.scm | 41 ++++++++++-------- 2 files changed, 69 insertions(+), 65 deletions(-) (limited to 'tests') diff --git a/tests/model-package-metadata.scm b/tests/model-package-metadata.scm index 2e67233..407b7d2 100644 --- a/tests/model-package-metadata.scm +++ b/tests/model-package-metadata.scm @@ -29,6 +29,19 @@ (home-page #f) (location #f))) +(define mock-inferior-packages + (list mock-inferior-package-foo + mock-inferior-package-foo-2)) + +(define mock-package-metadata + (map (lambda (mock-inf-pkg) + (list + (mock-inferior-package-home-page mock-inf-pkg) + (mock-inferior-package-location mock-inf-pkg) + `(("en_US.UTF-8" . "Fake synopsis")) + `(("en_US.UTF-8" . "Fake description")))) + mock-inferior-packages)) + (define (test-license-set-ids conn) (let ((license-id-lists (inferior-packages->license-id-lists @@ -39,54 +52,42 @@ (inferior-packages->license-set-ids conn license-id-lists))) -(mock - ((guix-data-service model package-metadata) - inferior-packages->translated-package-descriptions-and-synopsis - (lambda (inferior inferior-package) - (cons `(("en_US.UTF-8" . "Fake synopsis")) - `(("en_US.UTF-8" . "Fake description"))))) - (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-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-metadata" - (lambda (conn) - (check-test-database! conn) + (with-postgresql-connection + "test-model-package-metadata" + (lambda (conn) + (check-test-database! conn) - (test-assert "inferior-packages->package-metadata-ids" - (with-postgresql-transaction - conn - (lambda (conn) - (match - (inferior-packages->package-metadata-ids - conn - "" - (list mock-inferior-package-foo - mock-inferior-package-foo-2) - (test-license-set-ids conn)) - ((x) (number? x)))) - #:always-rollback? #t)) + (test-assert "inferior-packages->package-metadata-ids" + (with-postgresql-transaction + conn + (lambda (conn) + (match + (inferior-packages->package-metadata-ids + conn + mock-package-metadata + (test-license-set-ids conn)) + ((x) (number? x)))) + #:always-rollback? #t)) - (with-postgresql-transaction - conn - (lambda (conn) - (test-equal "inferior-packages->package-metadata-ids" - (inferior-packages->package-metadata-ids - conn - "" - (list mock-inferior-package-foo - mock-inferior-package-foo-2) - (test-license-set-ids conn)) - (inferior-packages->package-metadata-ids - conn - "" - (list mock-inferior-package-foo - mock-inferior-package-foo-2) - (test-license-set-ids conn))) - #:always-rollback? #t))))))) + (with-postgresql-transaction + conn + (lambda (conn) + (test-equal "inferior-packages->package-metadata-ids" + (inferior-packages->package-metadata-ids + conn + mock-package-metadata + (test-license-set-ids conn)) + (inferior-packages->package-metadata-ids + conn + mock-package-metadata + (test-license-set-ids conn))) + #:always-rollback? #t)))))) (test-end) diff --git a/tests/model-package.scm b/tests/model-package.scm index a0fdc45..814a6e1 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 utils) #:use-module (guix-data-service model license) #:use-module (guix-data-service model license-set) #:use-module (guix-data-service model package) @@ -45,16 +46,18 @@ (list mock-inferior-package-foo mock-inferior-package-foo-2)) -(mock - ((guix-data-service model package-metadata) - inferior-packages->translated-package-descriptions-and-synopsis - (lambda (inferior inferior-package) - (cons `(("en_US.UTF-8" . "Fake synopsis")) - `(("en_US.UTF-8" . "Fake description"))))) +(define mock-package-metadata + (map (lambda (mock-inf-pkg) + (list + (mock-inferior-package-home-page mock-inf-pkg) + (mock-inferior-package-location mock-inf-pkg) + `(("en_US.UTF-8" . "Fake synopsis")) + `(("en_US.UTF-8" . "Fake description")))) + mock-inferior-packages)) + (with-mock-inferior-packages (lambda () - (use-modules (guix-data-service model utils) - (guix-data-service model package) + (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)) @@ -68,11 +71,11 @@ 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))) + (let ((package-metadata-ids + (inferior-packages->package-metadata-ids + conn + mock-package-metadata + (test-license-set-ids conn))) (package-replacement-package-ids (make-list (length mock-inferior-packages) (cons "integer" NULL)))) @@ -88,11 +91,11 @@ (with-postgresql-transaction conn (lambda (conn) - (let ((package-metadata-ids (inferior-packages->package-metadata-ids - conn - "" - mock-inferior-packages - (test-license-set-ids conn))) + (let ((package-metadata-ids + (inferior-packages->package-metadata-ids + conn + mock-package-metadata + (test-license-set-ids conn))) (package-replacement-package-ids (make-list (length mock-inferior-packages) (cons "integer" NULL)))) @@ -109,6 +112,6 @@ (map mock-inferior-package-version mock-inferior-packages) package-metadata-ids package-replacement-package-ids))))) - #:always-rollback? #t)))))) + #:always-rollback? #t))))) (test-end) -- cgit v1.2.3