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:
Ludovic Courtès 2015-04-12 23:14:19 +02:00
parent 866f469edd
commit 002c57c6f7
2 changed files with 37 additions and 0 deletions

View File

@ -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 @@
#: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 @@
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 @@ descriptions maintained upstream."
(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 @@ descriptions maintained upstream."
(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")

View File

@ -319,6 +319,16 @@ requests."
(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