From 40fa21c22e1d11b741515fd38f5204a5fa57fbaa Mon Sep 17 00:00:00 2001
From: Arun Isaac <arunisaac@systemreboot.net>
Date: Mon, 7 Jan 2019 23:11:58 +0530
Subject: guix: lint: Warn only if GitHub URI is not same as the package URI.

* guix/scripts/lint.scm (check-github-url): Warn only if the GitHub URI
obtained after following redirects is not same as the original URI.
* tests/lint.scm ("github-url: already the correct github url"): New test.
---
 guix/scripts/lint.scm | 11 ++++++-----
 tests/lint.scm        | 13 +++++++++++--
 2 files changed, 17 insertions(+), 7 deletions(-)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 9acec48577..0f315a9352 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -8,7 +8,7 @@
 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2017, 2018 Efraim Flashner <efraim@flashner.co.il>
-;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -820,10 +820,11 @@ descriptions maintained upstream."
        (lambda (uri)
          (and=> (follow-redirects-to-github uri)
                 (lambda (github-uri)
-                  (emit-warning
-                   package
-                   (format #f (G_ "URL should be '~a'") github-uri)
-                   'source))))
+                  (unless (string=? github-uri uri)
+                    (emit-warning
+                     package
+                     (format #f (G_ "URL should be '~a'") github-uri)
+                     'source)))))
        (origin-uris origin)))))
 
 (define (check-derivation package)
diff --git a/tests/lint.scm b/tests/lint.scm
index fe12bebd88..912a78d111 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -6,7 +6,7 @@
 ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
-;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -775,7 +775,16 @@
                                       (method url-fetch)
                                       (uri (%local-url))
                                       (sha256 %null-sha256))))))))))
-     github-url)))
+     github-url))
+  (test-assert "github-url: already the correct github url"
+    (string-null?
+     (with-warnings
+       (check-github-url
+        (dummy-package "x" (source
+                            (origin
+                              (method url-fetch)
+                              (uri github-url)
+                              (sha256 %null-sha256)))))))))
 
 (test-assert "cve"
   (mock ((guix scripts lint) package-vulnerabilities (const '()))
-- 
cgit v1.2.3