diff options
| -rw-r--r-- | guix/scripts/lint.scm | 50 | ||||
| -rw-r--r-- | tests/lint.scm | 16 |
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 |