From 153cb8e5782946bd0c9de22022a475ae9fef70ea Mon Sep 17 00:00:00 2001
Message-Id: <153cb8e5782946bd0c9de22022a475ae9fef70ea.1683184269.git.ludo@gnu.org>
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 4 May 2023 09:09:03 +0200
Subject: [PATCH] lint: archival: Warn against non-origin package sources.

Suggested by Maxim Cournoyer <maxim.cournoyer@gmail.com>
and Simon Tournier <zimon.toutoune@gmail.com>.

* guix/lint.scm (check-archival): Add 'local-file?' clause.  Clarify
message in case (package-source package) is not an origin.
* tests/lint.scm ("archival: not an origin"): New test.
---
 guix/lint.scm  | 11 +++++++----
 tests/lint.scm | 11 +++++++++--
 2 files changed, 16 insertions(+), 6 deletions(-)

diff --git a/guix/lint.scm b/guix/lint.scm
index 0ed5b8dc98..72b3f4e7b1 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -1610,11 +1610,11 @@ (define (check-archival package)
   (parameterize ((%allow-request? skip-when-limit-reached))
     (catch #t
       (lambda ()
-        (match (and (origin? (package-source package))
-                    (package-source package))
+        (match (package-source package)
           (#f                                     ;no source
            '())
-          ((= origin-uri (? git-reference? reference))
+          ((and (? origin?)
+                (= origin-uri (? git-reference? reference)))
            (define url
              (git-reference-url reference))
            (define commit
@@ -1680,9 +1680,12 @@ (define (check-archival package)
                    ((? content?)
                     '())))
                '()))
+          ((? local-file?)
+           '())
           (_
            (list (make-warning package
-                               (G_ "unsupported source type")
+                               (G_ "\
+source is not an origin, it cannot be archived")
                                #:field 'source)))))
       (match-lambda*
         (('swh-error url method response)
diff --git a/tests/lint.scm b/tests/lint.scm
index ce22e2355a..b91bd053c5 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
 ;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org>
-;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
@@ -43,7 +43,8 @@ (define-module (test-lint)
   #:use-module (guix lint)
   #:use-module (guix ui)
   #:use-module (guix swh)
-  #:use-module ((guix gexp) #:select (gexp local-file gexp?))
+  #:use-module ((guix gexp)
+                #:select (gexp local-file computed-file gexp?))
   #:use-module ((guix utils) #:select (call-with-temporary-directory))
   #:use-module ((guix import hackage) #:select (%hackage-url))
   #:use-module ((guix import stackage) #:select (%stackage-url))
@@ -1298,6 +1299,12 @@ (define (package-with-phase-changes changes)
   '()
   (check-formatting (dummy-package "x")))
 
+(test-assert "archival: not an origin"
+  (warning-contains? "not an origin"
+                     (check-archival
+                      (dummy-package
+                       "x" (source (computed-file "x-src" #t))))))
+
 (test-assert "archival: missing content"
   (let* ((origin   (origin
                      (method url-fetch)

base-commit: 44d70440944aa47e5f37493346e560f38907d777
-- 
2.39.2