From 20be23c3b67dd181a2c4b468626490a7eb74e492 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 27 Apr 2016 10:05:45 +0200 Subject: 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. --- guix/scripts/lint.scm | 50 +++++++++++++++++++++++++++++++------------------- 1 file changed, 31 insertions(+), 19 deletions(-) (limited to 'guix/scripts/lint.scm') 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 @@ (define (check-end-of-sentence-space description) '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 @@ (define (check-start-with-package-name 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 @@ (define (check-gnu-synopsis+description package) (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 @@ (define (check-gnu-synopsis+description package) (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) -- cgit v1.2.3