From 52b9efe337d00f2ce65c4d4ca74ccc3679e6aad8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 6 Sep 2015 10:54:51 +0200 Subject: [PATCH] lint: Add 'license' checker. * guix/scripts/lint.scm (check-license): New procedure. (%checkers): Add 'license' checker. * tests/lint.scm ("license: invalid license"): New test. --- guix/scripts/lint.scm | 19 +++++++++++++++++++ tests/lint.scm | 6 ++++++ 2 files changed, 25 insertions(+) diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 41249b2d15..2a618c9451 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -24,6 +24,7 @@ #:use-module (guix download) #:use-module (guix ftp-client) #:use-module (guix packages) + #:use-module (guix licenses) #:use-module (guix records) #:use-module (guix ui) #:use-module (guix utils) @@ -56,6 +57,7 @@ check-derivation check-home-page check-source + check-license check-formatting %checkers @@ -518,6 +520,16 @@ descriptions maintained upstream." (format #f (_ "failed to create derivation: ~s~%") args))))) +(define (check-license package) + "Warn about type errors of the 'license' field of PACKAGE." + (match (package-license package) + ((or (? license?) + ((? license?) ...)) + #t) + (x + (emit-warning package (_ "invalid license field") + 'license)))) + ;;; ;;; Source code formatting. @@ -619,6 +631,13 @@ them for PACKAGE." (name 'home-page) (description "Validate home-page URLs") (check check-home-page)) + (lint-checker + (name 'license) + ;; TRANSLATORS: is the name of a data type and must not be + ;; translated. + (description "Make sure the 'license' field is a \ +or a list thereof") + (check check-license)) (lint-checker (name 'source) (description "Validate source URLs") diff --git a/tests/lint.scm b/tests/lint.scm index 5d56420966..ac47dbb768 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -329,6 +329,12 @@ requests." (check-derivation pkg))) "failed to create derivation"))) +(test-assert "license: invalid license" + (string-contains + (with-warnings + (check-license (dummy-package "x" (license #f)))) + "invalid license")) + (test-assert "home-page: wrong home-page" (->bool (string-contains