lint: Report synopses/descriptions that are not strings.

Suggested by John Darrington.

* guix/scripts/lint.scm (check-description-style): Emit a warning when
DESCRIPTION is not a string.
(check-synopsis-style): Likewise.
(check-gnu-synopsis+description): Likewise.
* tests/lint.scm ("description: not a string", "synopsis: not a
string"): New tests.
This commit is contained in:
Ludovic Courtès 2016-04-27 10:05:45 +02:00
parent 068e476f68
commit 20be23c3b6
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 47 additions and 19 deletions

View File

@ -187,13 +187,17 @@ by two spaces; possible infraction~p at ~{~a~^, ~}")
'description))))
(let ((description (package-description package)))
(when (string? description)
(if (string? description)
(begin
(check-not-empty description)
;; Use raw description for this because Texinfo rendering automatically
;; fixes end of sentence space.
;; Use raw description for this because Texinfo rendering
;; automatically fixes end of sentence space.
(check-end-of-sentence-space description)
(and=> (check-texinfo-markup description)
check-proper-start))))
check-proper-start))
(emit-warning package
(format #f (_ "invalid description: ~s") description)
'description))))
(define (check-inputs-should-be-native package)
;; Emit a warning if some inputs of PACKAGE are likely to belong to its
@ -262,14 +266,19 @@ the synopsis")
(_ "synopsis should not start with the package name")
'synopsis)))
(let ((synopsis (package-synopsis package)))
(when (string? synopsis)
(check-not-empty synopsis)
(check-proper-start synopsis)
(check-final-period synopsis)
(check-start-article synopsis)
(check-start-with-package-name synopsis)
(check-synopsis-length synopsis))))
(define checks
(list check-not-empty check-proper-start check-final-period
check-start-article check-start-with-package-name
check-synopsis-length))
(match (package-synopsis package)
((? string? synopsis)
(for-each (lambda (proc)
(proc synopsis))
checks))
(invalid
(emit-warning package (format #f (_ "invalid synopsis: ~s") invalid)
'synopsis))))
(define* (probe-uri uri #:key timeout)
"Probe URI, a URI object, and return two values: a symbol denoting the
@ -464,7 +473,9 @@ descriptions maintained upstream."
(downstream (package-synopsis package))
(loc (or (package-field-location package 'synopsis)
(package-location package))))
(unless (and upstream (string=? upstream downstream))
(when (and upstream
(or (not (string? downstream))
(not (string=? upstream downstream))))
(format (guix-warning-port)
(_ "~a: ~a: proposed synopsis: ~s~%")
(location->string loc) (package-full-name package)
@ -475,8 +486,9 @@ descriptions maintained upstream."
(loc (or (package-field-location package 'description)
(package-location package))))
(when (and upstream
(or (not (string? downstream))
(not (string=? (fill-paragraph upstream 100)
(fill-paragraph downstream 100))))
(fill-paragraph downstream 100)))))
(format (guix-warning-port)
(_ "~a: ~a: proposed description:~% \"~a\"~%")
(location->string loc) (package-full-name package)

View File

@ -138,6 +138,14 @@ requests."
(define-syntax-rule (with-warnings body ...)
(call-with-warnings (lambda () body ...)))
(test-assert "description: not a string"
(->bool
(string-contains (with-warnings
(let ((pkg (dummy-package "x"
(description 'foobar))))
(check-description-style pkg)))
"invalid description")))
(test-assert "description: not empty"
(->bool
(string-contains (with-warnings
@ -191,6 +199,14 @@ requests."
"E.g. Foo, i.e. Bar resp. Baz (a.k.a. DVD)."))))
(check-description-style pkg)))))
(test-assert "synopsis: not a string"
(->bool
(string-contains (with-warnings
(let ((pkg (dummy-package "x"
(synopsis #f))))
(check-synopsis-style pkg)))
"invalid synopsis")))
(test-assert "synopsis: not empty"
(->bool
(string-contains (with-warnings