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.
			
			
This commit is contained in:
		
							parent
							
								
									5c5bdab929
								
							
						
					
					
						commit
						71fd35c1d5
					
				
					 2 changed files with 16 additions and 6 deletions
				
			
		|  | @ -1610,11 +1610,11 @@ try again later") | |||
|   (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 @@ Disarchive entry refers to non-existent SWH directory '~a'") | |||
|                    ((? 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) | ||||
|  |  | |||
|  | @ -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 @@ | |||
|   #: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 @@ | |||
|   '() | ||||
|   (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) | ||||
|  |  | |||
		Reference in a new issue