(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 utils) #: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) #: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) (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 license-id-lists))) (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)) (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) (check-test-database! 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-package-metadata (test-license-set-ids conn))) (package-replacement-package-ids (make-list (length mock-inferior-packages) (cons "integer" NULL)))) (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 package-replacement-package-ids)) ((x) (number? x)))))) #:always-rollback? #t) (with-postgresql-transaction conn (lambda (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)))) (test-equal "inferior-packages->package-ids is idempotent" (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 package-replacement-package-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 package-replacement-package-ids))))) #:always-rollback? #t))))) (test-end)