Merge branch 'master' into gnome-team

1 files changed, 43 insertions, 20 deletions

diff --git a/tests/cpan.scm b/tests/cpan.scm
index bbcd108e12..e4ee788e9d 100644
--- a/tests/cpan.scm
+++ b/tests/cpan.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
-;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020, 2023 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,7 +21,10 @@
 (define-module (test-cpan)
   #:use-module (guix import cpan)
   #:use-module (guix base32)
+  #:use-module (guix upstream)
+  #:use-module ((guix download) #:select (url-fetch))
   #:use-module (gcrypt hash)
+  #:use-module (guix tests)
   #:use-module (guix tests http)
   #:use-module ((guix store) #:select (%graft?))
   #:use-module (srfi srfi-64)
@@ -64,37 +67,57 @@
 (test-begin "cpan")
 
 (test-assert "cpan->guix-package"
-  ;; Replace network resources with sample data.
   (with-http-server `((200 ,test-json)
                       (200 ,test-source)
                       (200 "{ \"distribution\" : \"Test-Script\" }"))
     (parameterize ((%metacpan-base-url (%local-url))
                    (current-http-proxy (%local-url)))
       (match (cpan->guix-package "Foo::Bar")
-        (('package
-           ('name "perl-foo-bar")
-           ('version "0.1")
-           ('source ('origin
-                      ('method 'url-fetch)
-                      ('uri ('string-append "http://example.com/Foo-Bar-"
-                                            'version ".tar.gz"))
-                      ('sha256
-                       ('base32
-                        (? string? hash)))))
-           ('build-system 'perl-build-system)
-           ('propagated-inputs
-            ('quasiquote
-             (("perl-test-script" ('unquote 'perl-test-script)))))
-           ('home-page "https://metacpan.org/release/Foo-Bar")
-           ('synopsis "Fizzle Fuzz")
-           ('description 'fill-in-yourself!)
-           ('license 'perl-license))
+        (`(package
+            (name "perl-foo-bar")
+            (version "0.1")
+            (source (origin
+                      (method url-fetch)
+                      (uri (string-append "http://example.com/Foo-Bar-"
+                                          version ".tar.gz"))
+                      (sha256
+                       (base32 ,(? string? hash)))))
+            (build-system perl-build-system)
+            (propagated-inputs (list perl-test-script))
+            (home-page "https://metacpan.org/release/Foo-Bar")
+            (synopsis "Fizzle Fuzz")
+            (description fill-in-yourself!)
+            (license perl-license))
          (string=? (bytevector->nix-base32-string
                     (call-with-input-string test-source port-sha256))
                    hash))
         (x
          (pk 'fail x #f))))))
 
+(test-equal "package-latest-release"
+  (list '("http://example.com/Foo-Bar-0.1.tar.gz")
+        #f
+        (list (upstream-input
+               (name "Test-Script")
+               (downstream-name "perl-test-script")
+               (type 'propagated))))
+  (with-http-server `((200 ,test-json)
+                      (200 ,test-source)
+                      (200 "{ \"distribution\" : \"Test-Script\" }"))
+    (define source
+      (parameterize ((%metacpan-base-url (%local-url)))
+        (package-latest-release
+         (dummy-package "perl-test-script"
+                        (version "0.0.0")
+                        (source (dummy-origin
+                                 (method url-fetch)
+                                 (uri "mirror://cpan/Foo-Bar-0.0.0.tgz"))))
+         (list %cpan-updater))))
+
+    (list (upstream-source-urls source)
+          (upstream-source-signature-urls source)
+          (upstream-source-inputs source))))
+
 (test-equal "metacpan-url->mirror-url, http"
   "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"
   (metacpan-url->mirror-url