aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/scripts/lint.scm50
-rw-r--r--tests/lint.scm16
2 files changed, 47 insertions, 19 deletions
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index d2fed67e13..a8023a5b1e 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -187,13 +187,17 @@ by two spaces; possible infraction~p at ~{~a~^, ~}")
'description))))
(let ((description (package-description package)))
- (when (string? description)
- (check-not-empty description)
- ;; 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))))
+ (if (string? description)
+ (begin
+ (check-not-empty description)
+ ;; 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))
+ (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
@@ -459,12 +468,14 @@ descriptions maintained upstream."
(official-gnu-packages*))
(#f ;not a GNU package, so nothing to do
#t)
- (descriptor ;a genuine GNU package
+ (descriptor ;a genuine GNU package
(let ((upstream (gnu-package-doc-summary descriptor))
(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
- (not (string=? (fill-paragraph upstream 100)
- (fill-paragraph downstream 100))))
+ (or (not (string? downstream))
+ (not (string=? (fill-paragraph upstream 100)
+ (fill-paragraph downstream 100)))))
(format (guix-warning-port)
(_ "~a: ~a: proposed description:~% \"~a\"~%")
(location->string loc) (package-full-name package)
diff --git a/tests/lint.scm b/tests/lint.scm
index 4f0196491d..9bc42990ef 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -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