summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/lint.scm55
-rw-r--r--tests/lint.scm56
2 files changed, 111 insertions, 0 deletions
diff --git a/guix/lint.scm b/guix/lint.scm
index 91dbc806dc..0b38ca0d33 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -35,6 +35,8 @@
#:use-module (guix http-client)
#:use-module (guix packages)
#:use-module (guix i18n)
+ #:use-module ((guix gexp)
+ #:select (local-file? local-file-absolute-file-name))
#:use-module (guix licenses)
#:use-module (guix records)
#:use-module (guix grafts)
@@ -73,6 +75,7 @@
check-inputs-should-be-native
check-inputs-should-not-be-an-input-at-all
check-patch-file-names
+ check-patch-headers
check-synopsis-style
check-derivation
check-home-page
@@ -712,6 +715,54 @@ patch could not be found."
(_ #f))
patches)))))
+(define (check-patch-headers package)
+ "Check that PACKAGE's patches start with a comment. Return a list of
+warnings."
+ (define (blank? str)
+ (string-every char-set:blank str))
+
+ (define (patch-header-warnings patch)
+ (call-with-input-file patch
+ (lambda (port)
+ ;; Read from PORT until a non-blank line is found or EOF is reached.
+ (let loop ()
+ (let ((line (read-line port)))
+ (cond ((eof-object? line)
+ (list (make-warning package
+ (G_ "~a: empty patch")
+ (list (basename patch))
+ #:field 'source)))
+ ((blank? line)
+ (loop))
+ ((or (string-prefix? "--- " line)
+ (string-prefix? "+++ " line))
+ (list (make-warning package
+ (G_ "~a: patch lacks comment and \
+upstream status")
+ (list (basename patch))
+ #:field 'source)))
+ (else
+ '())))))))
+
+ (guard (c ((formatted-message? c) ;raised by 'search-patch'
+ (list (%make-warning package
+ (formatted-message-string c)
+ (formatted-message-arguments c)
+ #:field 'source))))
+ (let ((patches (if (origin? (package-source package))
+ (origin-patches (package-source package))
+ '())))
+ (append-map (lambda (patch)
+ ;; Dismiss PATCH if it's an origin or similar.
+ (cond ((string? patch)
+ (patch-header-warnings patch))
+ ((local-file? patch)
+ (patch-header-warnings
+ (local-file-absolute-file-name patch)))
+ (else
+ '())))
+ patches))))
+
(define (escape-quotes str)
"Replace any quote character in STR by an escaped quote character."
(list->string
@@ -1418,6 +1469,10 @@ or a list thereof")
(description "Validate file names and availability of patches")
(check check-patch-file-names))
(lint-checker
+ (name 'patch-headers)
+ (description "Validate patch headers")
+ (check check-patch-headers))
+ (lint-checker
(name 'formatting)
(description "Look for formatting issues in the source")
(check check-formatting))))
diff --git a/tests/lint.scm b/tests/lint.scm
index 95abd71378..bd052842f3 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -36,6 +36,8 @@
#:use-module (guix lint)
#:use-module (guix ui)
#:use-module (guix swh)
+ #:use-module ((guix gexp) #:select (local-file))
+ #:use-module ((guix utils) #:select (call-with-temporary-directory))
#:use-module (gnu packages)
#:use-module (gnu packages glib)
#:use-module (gnu packages pkg-config)
@@ -344,6 +346,60 @@
(list (search-patch "this-patch-does-not-exist!"))))))))
(check-patch-file-names pkg))))
+(test-assert "patch headers: no warnings"
+ (call-with-temporary-directory
+ (lambda (directory)
+ (call-with-output-file (string-append directory "/t.patch")
+ (lambda (port)
+ (display "This is a patch.\n\n--- a\n+++ b\n"
+ port)))
+
+ (parameterize ((%patch-path (list directory)))
+ (let ((pkg (dummy-package "x"
+ (source (dummy-origin
+ (patches (search-patches "t.patch")))))))
+ (null? (check-patch-headers pkg)))))))
+
+(test-equal "patch headers: missing comment"
+ "t.patch: patch lacks comment and upstream status"
+ (call-with-temporary-directory
+ (lambda (directory)
+ (call-with-output-file (string-append directory "/t.patch")
+ (lambda (port)
+ (display "\n--- a\n+++ b\n"
+ port)))
+
+ (parameterize ((%patch-path (list directory)))
+ (let ((pkg (dummy-package "x"
+ (source (dummy-origin
+ (patches (search-patches "t.patch")))))))
+ (single-lint-warning-message (check-patch-headers pkg)))))))
+
+(test-equal "patch headers: empty"
+ "t.patch: empty patch"
+ (call-with-temporary-directory
+ (lambda (directory)
+ (call-with-output-file (string-append directory "/t.patch")
+ (const #t))
+
+ (parameterize ((%patch-path '()))
+ (let ((pkg (dummy-package "x"
+ (source (dummy-origin
+ (patches
+ (list (local-file
+ (string-append directory
+ "/t.patch")))))))))
+ (single-lint-warning-message (check-patch-headers pkg)))))))
+
+(test-equal "patch headers: patch not found"
+ "does-not-exist.patch: patch not found\n"
+ (parameterize ((%patch-path '()))
+ (let ((pkg (dummy-package "x"
+ (source (dummy-origin
+ (patches
+ (search-patches "does-not-exist.patch")))))))
+ (single-lint-warning-message (check-patch-headers pkg)))))
+
(test-equal "derivation: invalid arguments"
"failed to create x86_64-linux derivation: (wrong-type-arg \"map\" \"Wrong type argument: ~S\" (invalid-module) ())"
(match (let ((pkg (dummy-package "x"