ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-13 06:36:37 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

lint: Report synopses/descriptions that are not strings.

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

50
guix/scripts/lint.scm
View file

@ -187,13 +187,17 @@ (define (check-end-of-sentence-space description)
'description)))) 'description))))
(let ((description (package-description package))) (let ((description (package-description package)))
(when (string? description) (if (string? description)
(check-not-empty description) (begin
;; Use raw description for this because Texinfo rendering automatically (check-not-empty description)
;; fixes end of sentence space. ;; Use raw description for this because Texinfo rendering
(check-end-of-sentence-space description) ;; automatically fixes end of sentence space.
(and=> (check-texinfo-markup description) (check-end-of-sentence-space description)
check-proper-start)))) (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) (define (check-inputs-should-be-native package)
;; Emit a warning if some inputs of PACKAGE are likely to belong to its ;; 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 should not start with the package name")
'synopsis))) 'synopsis)))
(let ((synopsis (package-synopsis package))) (define checks
(when (string? synopsis) (list check-not-empty check-proper-start check-final-period
(check-not-empty synopsis) check-start-article check-start-with-package-name
(check-proper-start synopsis) check-synopsis-length))
(check-final-period synopsis)
(check-start-article synopsis) (match (package-synopsis package)
(check-start-with-package-name synopsis) ((? string? synopsis)
(check-synopsis-length 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) (define* (probe-uri uri #:key timeout)
"Probe URI, a URI object, and return two values: a symbol denoting the "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*)) (official-gnu-packages*))
(#f ;not a GNU package, so nothing to do (#f ;not a GNU package, so nothing to do
#t) #t)
(descriptor ;a genuine GNU package (descriptor ;a genuine GNU package
(let ((upstream (gnu-package-doc-summary descriptor)) (let ((upstream (gnu-package-doc-summary descriptor))
(downstream (package-synopsis package)) (downstream (package-synopsis package))
(loc (or (package-field-location package 'synopsis) (loc (or (package-field-location package 'synopsis)
(package-location package)))) (package-location package))))
(unless (and upstream (string=? upstream downstream)) (when (and upstream
(or (not (string? downstream))
(not (string=? upstream downstream))))
(format (guix-warning-port) (format (guix-warning-port)
(_ "~a: ~a: proposed synopsis: ~s~%") (_ "~a: ~a: proposed synopsis: ~s~%")
(location->string loc) (package-full-name package) (location->string loc) (package-full-name package)
@ -475,8 +486,9 @@ (define (check-gnu-synopsis+description package)
(loc (or (package-field-location package 'description) (loc (or (package-field-location package 'description)
(package-location package)))) (package-location package))))
(when (and upstream (when (and upstream
(not (string=? (fill-paragraph upstream 100) (or (not (string? downstream))
(fill-paragraph downstream 100)))) (not (string=? (fill-paragraph upstream 100)
(fill-paragraph downstream 100)))))
(format (guix-warning-port) (format (guix-warning-port)
(_ "~a: ~a: proposed description:~% \"~a\"~%") (_ "~a: ~a: proposed description:~% \"~a\"~%")
(location->string loc) (package-full-name package) (location->string loc) (package-full-name package)

16
tests/lint.scm
View file

@ -138,6 +138,14 @@ (define (call-with-warnings thunk)
(define-syntax-rule (with-warnings body ...) (define-syntax-rule (with-warnings body ...)
(call-with-warnings (lambda () 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" (test-assert "description: not empty"
(->bool (->bool
(string-contains (with-warnings (string-contains (with-warnings
@ -191,6 +199,14 @@ (define-syntax-rule (with-warnings body ...)
"E.g. Foo, i.e. Bar resp. Baz (a.k.a. DVD).")))) "E.g. Foo, i.e. Bar resp. Baz (a.k.a. DVD)."))))
(check-description-style pkg))))) (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" (test-assert "synopsis: not empty"
(->bool (->bool
(string-contains (with-warnings (string-contains (with-warnings