upstream: Define ‘preferred-upstream-source’.

* guix/upstream.scm (preferred-upstream-source): New procedure.
* tests/upstream.scm ("preferred-upstream-source"): New test.

Change-Id: I4b48b44f1aa233d2e99bfe2e1359a670297efae8

1 files changed, 20 insertions, 1 deletions

diff --git a/tests/upstream.scm b/tests/upstream.scm
index a94bb66068..c75ab091e5 100644
--- a/tests/upstream.scm
+++ b/tests/upstream.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2023-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -26,6 +26,7 @@
   #:use-module ((guix licenses) #:prefix license:)
   #:use-module (guix upstream)
   #:use-module (guix tests)
+  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-64)
   #:use-module (ice-9 match))
 
@@ -55,4 +56,22 @@
                                 (signature-urls
                                  '("ftp://example.org/foo-1.tar.xz.sig")))))))
 
+(test-equal "preferred-upstream-source"
+  '(("http://example.org/foo-2.0.tar.xz")
+    ("http://example.org/foo-2.0.tar.xz.sig"))
+  (let* ((package (dummy-package
+                   "foo"
+                   (version "1.0")
+                   (source
+                    (dummy-origin (uri "http://example.org/foo-1.0.tar.xz")))))
+         (source (upstream-source
+                  (package "foo")
+                  (version "2.0")
+                  (urls '("http://example.org/foo-2.0.tar.gz"
+                          "http://example.org/foo-2.0.tar.xz"))
+                  (signature-urls (map (cut string-append <> ".sig") urls))))
+         (preferred (preferred-upstream-source source package)))
+    (list (upstream-source-urls preferred)
+          (upstream-source-signature-urls preferred))))
+
 (test-end)