05/05: lint: source: Handle <svn-multi-reference> origins.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit e0b414fc599c2d9092dfa57455f035cbedb7810e
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Oct 20 22:22:31 2022 +0200

    lint: source: Handle <svn-multi-reference> origins.
    
    This is a followup to 2383e145185efb2e6f99931707ec93d65d166432.
    
    * guix/lint.scm (svn-reference-uri-with-userinfo): Accept REF being
    an <svn-multi-reference> record.
    (check-source): Handle 'svn-multi-reference?' origins like
    'svn-reference?' origins.
---
 guix/lint.scm | 40 ++++++++++++++++++++++++++++++----------
 1 file changed, 30 insertions(+), 10 deletions(-)

diff --git a/guix/lint.scm b/guix/lint.scm
index 9f155b71d4..6e9d11074b 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -63,7 +63,12 @@
   #:autoload   (guix svn-download) (svn-reference?
                                     svn-reference-url
                                     svn-reference-user-name
-                                    svn-reference-password)
+                                    svn-reference-password
+
+                                    svn-multi-reference?
+                                    svn-multi-reference-url
+                                    svn-multi-reference-user-name
+                                    svn-multi-reference-password)
   #:use-module (guix import stackage)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
@@ -1143,18 +1148,32 @@ descriptions maintained upstream."
      uris)))
 
 (define (svn-reference-uri-with-userinfo ref)
-  "Return the URI of REF, an <svn-reference> object, but with an additional
-'userinfo' part corresponding to REF's user name and password, provided REF's
-URI is HTTP or HTTPS."
-  (let ((uri (string->uri (svn-reference-url ref))))
-    (if (and (svn-reference-user-name ref)
+  "Return the URI of REF, an <svn-reference> or <svn-multi-reference> object,
+but with an additional 'userinfo' part corresponding to REF's user name and
+password, provided REF's URI is HTTP or HTTPS."
+  ;; XXX: For lack of record type inheritance.
+  (define ->url
+    (if (svn-reference? ref)
+        svn-reference-url
+        svn-multi-reference-url))
+  (define ->user-name
+    (if (svn-reference? ref)
+        svn-reference-user-name
+        svn-multi-reference-user-name))
+  (define ->password
+    (if (svn-reference? ref)
+        svn-reference-password
+        svn-multi-reference-password))
+
+  (let ((uri (string->uri (->url ref))))
+    (if (and (->user-name ref)
              (memq (uri-scheme uri) '(http https)))
         (build-uri (uri-scheme uri)
                    #:userinfo
-                   (string-append (svn-reference-user-name ref)
-                                  (if (svn-reference-password ref)
+                   (string-append (->user-name ref)
+                                  (if (->password ref)
                                       (string-append
-                                       ":" (svn-reference-password ref))
+                                       ":" (->password ref))
                                       ""))
                    #:host (uri-host uri)
                    #:port (uri-port uri)
@@ -1207,7 +1226,8 @@ URI is HTTP or HTTPS."
          ((git-reference? (origin-uri origin))
           (warnings-for-uris
            (list (string->uri (git-reference-url (origin-uri origin))))))
-         ((svn-reference? (origin-uri origin))
+         ((or (svn-reference? (origin-uri origin))
+              (svn-multi-reference? (origin-uri origin)))
           (let ((uri (svn-reference-uri-with-userinfo (origin-uri origin))))
             (if (memq (uri-scheme uri) '(http https))
                 (warnings-for-uris (list uri))