mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
lint: Add a 'derivation' checker.
* guix/scripts/lint.scm (check-derivation): New procedure. (%checkers): Add 'derivation' checker. * tests/lint.scm ("derivation: invalid arguments"): New test.
This commit is contained in:
parent
866f469edd
commit
002c57c6f7
2 changed files with 37 additions and 0 deletions
|
@ -19,6 +19,7 @@
|
||||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(define-module (guix scripts lint)
|
(define-module (guix scripts lint)
|
||||||
|
#:use-module (guix store)
|
||||||
#:use-module (guix base32)
|
#:use-module (guix base32)
|
||||||
#:use-module (guix download)
|
#:use-module (guix download)
|
||||||
#:use-module (guix ftp-client)
|
#:use-module (guix ftp-client)
|
||||||
|
@ -32,6 +33,8 @@ (define-module (guix scripts lint)
|
||||||
#:use-module (ice-9 regex)
|
#:use-module (ice-9 regex)
|
||||||
#:use-module (ice-9 format)
|
#:use-module (ice-9 format)
|
||||||
#:use-module (web uri)
|
#:use-module (web uri)
|
||||||
|
#:use-module (srfi srfi-34)
|
||||||
|
#:use-module (srfi srfi-35)
|
||||||
#:use-module ((guix build download)
|
#:use-module ((guix build download)
|
||||||
#:select (maybe-expand-mirrors
|
#:select (maybe-expand-mirrors
|
||||||
open-connection-for-uri))
|
open-connection-for-uri))
|
||||||
|
@ -49,6 +52,7 @@ (define-module (guix scripts lint)
|
||||||
check-inputs-should-be-native
|
check-inputs-should-be-native
|
||||||
check-patch-file-names
|
check-patch-file-names
|
||||||
check-synopsis-style
|
check-synopsis-style
|
||||||
|
check-derivation
|
||||||
check-home-page
|
check-home-page
|
||||||
check-source))
|
check-source))
|
||||||
|
|
||||||
|
@ -440,6 +444,25 @@ (define (check-source package)
|
||||||
(append-map (cut maybe-expand-mirrors <> %mirrors)
|
(append-map (cut maybe-expand-mirrors <> %mirrors)
|
||||||
uris))))))
|
uris))))))
|
||||||
|
|
||||||
|
(define (check-derivation package)
|
||||||
|
"Emit a warning if we fail to compile PACKAGE to a derivation."
|
||||||
|
(catch #t
|
||||||
|
(lambda ()
|
||||||
|
(guard (c ((nix-protocol-error? c)
|
||||||
|
(emit-warning package
|
||||||
|
(format #f (_ "failed to create derivation: ~a")
|
||||||
|
(nix-protocol-error-message c))))
|
||||||
|
((message-condition? c)
|
||||||
|
(emit-warning package
|
||||||
|
(format #f (_ "failed to create derivation: ~a")
|
||||||
|
(condition-message c)))))
|
||||||
|
(with-store store
|
||||||
|
(package-derivation store package))))
|
||||||
|
(lambda args
|
||||||
|
(emit-warning package
|
||||||
|
(format #f (_ "failed to create derivation: ~s~%")
|
||||||
|
args)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
@ -472,6 +495,10 @@ (define %checkers
|
||||||
(name 'source)
|
(name 'source)
|
||||||
(description "Validate source URLs")
|
(description "Validate source URLs")
|
||||||
(check check-source))
|
(check check-source))
|
||||||
|
(lint-checker
|
||||||
|
(name 'derivation)
|
||||||
|
(description "Report failure to compile a package to a derivation")
|
||||||
|
(check check-derivation))
|
||||||
(lint-checker
|
(lint-checker
|
||||||
(name 'synopsis)
|
(name 'synopsis)
|
||||||
(description "Validate package synopses")
|
(description "Validate package synopses")
|
||||||
|
|
|
@ -319,6 +319,16 @@ (define-syntax-rule (with-warnings body ...)
|
||||||
(check-patch-file-names pkg)))
|
(check-patch-file-names pkg)))
|
||||||
"patch not found")))
|
"patch not found")))
|
||||||
|
|
||||||
|
(test-assert "derivation: invalid arguments"
|
||||||
|
(->bool
|
||||||
|
(string-contains
|
||||||
|
(with-warnings
|
||||||
|
(let ((pkg (dummy-package "x"
|
||||||
|
(arguments
|
||||||
|
'(#:imported-modules (invalid-module))))))
|
||||||
|
(check-derivation pkg)))
|
||||||
|
"failed to create derivation")))
|
||||||
|
|
||||||
(test-assert "home-page: wrong home-page"
|
(test-assert "home-page: wrong home-page"
|
||||||
(->bool
|
(->bool
|
||||||
(string-contains
|
(string-contains
|
||||||
|
|
Loading…
Reference in a new issue