From 20be23c3b67dd181a2c4b468626490a7eb74e492 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 27 Apr 2016 10:05:45 +0200
Subject: [PATCH] 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 +++++++++++++++++++++++++++----------------
 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