me/guix
Archived
1
0
Fork 0
Code Activity

lint: archival: Warn against non-origin package sources.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2023-05-04 09:09:03 +02:00
parent 5c5bdab929
commit 71fd35c1d5
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 16 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
guix/lint.scm
View file

@ -1610,11 +1610,11 @@ try again later")
(parameterize ((%allow-request? skip-when-limit-reached)) (parameterize ((%allow-request? skip-when-limit-reached))
(catch #t (catch #t
(lambda () (lambda ()
(match (and (origin? (package-source package)) (match (package-source package)
(package-source package))
(#f ;no source (#f ;no source
'()) '())
((= origin-uri (? git-reference? reference)) ((and (? origin?)
(= origin-uri (? git-reference? reference)))
(define url (define url
(git-reference-url reference)) (git-reference-url reference))
(define commit (define commit
@ -1680,9 +1680,12 @@ Disarchive entry refers to non-existent SWH directory '~a'")
((? content?) ((? content?)
'()))) '())))
'())) '()))
((? local-file?)
'())
(_ (_
(list (make-warning package (list (make-warning package
(G_ "unsupported source type") (G_ "\
source is not an origin, it cannot be archived")
#:field 'source))))) #:field 'source)))))
(match-lambda* (match-lambda*
(('swh-error url method response) (('swh-error url method response)

11
tests/lint.scm
View file

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org> ;;; 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 © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2017 Alex Kost <alezost@gmail.com> ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
@ -43,7 +43,8 @@
#:use-module (guix lint) #:use-module (guix lint)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix swh) #: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 utils) #:select (call-with-temporary-directory))
#:use-module ((guix import hackage) #:select (%hackage-url)) #:use-module ((guix import hackage) #:select (%hackage-url))
#:use-module ((guix import stackage) #:select (%stackage-url)) #:use-module ((guix import stackage) #:select (%stackage-url))
@ -1298,6 +1299,12 @@
'() '()
(check-formatting (dummy-package "x"))) (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" (test-assert "archival: missing content"
(let* ((origin (origin (let* ((origin (origin
(method url-fetch) (method url-fetch)