04/09: import: print: Correctly handle URI lists.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit b3240ae846cb1ace2322a68eca3497f11d0be6f1
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Oct 29 22:23:21 2021 +0200

    import: print: Correctly handle URI lists.
    
    * guix/import/print.scm (package->code)[factorized-uri-code]: New
    procedure.
    [source->code]: Use it, and factorize URI when it's a list.
    * tests/print.scm (pkg-with-origin-input): Check origin URI to a list.
---
 guix/import/print.scm | 15 ++++++++++++---
 tests/print.scm       |  6 ++++--
 2 files changed, 16 insertions(+), 5 deletions(-)

diff --git a/guix/import/print.scm b/guix/import/print.scm
index 8acf5d5..4e65d18 100644
--- a/guix/import/print.scm
+++ b/guix/import/print.scm
@@ -25,6 +25,7 @@
   #:use-module (guix build-system)
   #:use-module (gnu packages)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:use-module (guix import utils)
   #:use-module (ice-9 control)
   #:use-module (ice-9 match)
@@ -72,6 +73,11 @@ when evaluated."
       (file-type (quote ,(search-path-specification-file-type spec)))
       (file-pattern ,(search-path-specification-file-pattern spec))))
 
+  (define (factorized-uri-code uri version)
+    (match (factorize-uri uri version)
+      ((? string? uri) uri)
+      ((factorized ...) `(string-append ,@factorized))))
+
   (define (source->code source version)
     (let ((uri       (origin-uri source))
           (method    (origin-method source))
@@ -90,9 +96,12 @@ when evaluated."
                              (guix svn-download)))
                       (procedure-name method)))
          (uri ,(if version
-                   `(string-append ,@(match (factorize-uri uri version)
-                                       ((? string? uri) (list uri))
-                                       (factorized factorized)))
+                   (match uri
+                     ((? string? uri)
+                      (factorized-uri-code uri version))
+                     ((lst ...)
+                      `(list
+                        ,@(map (cut factorized-uri-code <> version) uri))))
                    uri))
          ,(if (equal? (content-hash-algorithm hash) 'sha256)
               `(sha256 (base32 ,(bytevector->nix-base32-string
diff --git a/tests/print.scm b/tests/print.scm
index ad19f45..7f4c8cc 100644
--- a/tests/print.scm
+++ b/tests/print.scm
@@ -73,8 +73,10 @@
     (version "1.2.3")
     (source (origin
               (method url-fetch)
-              (uri (string-append "file:///tmp/test-"
-                                  version ".tar.gz"))
+              (uri (list (string-append "file:///tmp/test-"
+                                        version ".tar.gz")
+                         (string-append "http://example.org/test-";
+                                        version ".tar.gz")))
               (sha256
                (base32
                 "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))))