Subject: bug#35790: closed (Re: [bug#35790] [PATCH 4/4] lint: Separate checkers by dependence on the internet.)

From: [email-masked] (GNU bug Tracking System)
Date: Mon, 15 Jul 2019 22:24:04 +0000

Your bug report

#35790: [PATCH] scripts: lint: Handle warnings with a record type.

which was filed against the guix-patches package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
35790: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=35790
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: [bug#35790] [PATCH 4/4] lint: Separate checkers by dependence on the internet.
From: Christopher Baines <[email-masked]>
To: Ludovic Courtès <[email-masked]>
Cc: [email-masked]
Date: Mon, 15 Jul 2019 23:23:19 +0100
List-Id: <debbugs-submit.debbugs.gnu.org>

Ludovic Courtès <[email-masked]> writes:

> Hi!
>
> It seems to me we’re all set now.

Great, I've pushed these to master now.

> Thanks a lot for all the work and for your patience!

No problem :)

In terms of next steps, I think this is a big bit of the work needed to
get lint warnings in to the Guix Data Service done, but there's still a
big chunk to do.

I hope to start looking at actually trying to load in the lint warnings
soon. This might involve extending the inferior API if that's helpful. I
also want to attempt to store translations for the lint warnings in one
way or another, as that'll begin to address the lack of localisation in
the Guix Data Service.

There's also some thinking about how to manage the network dependent
checkers. I'd like to get that information in anyway, but also, I think
it might be possible to maybe separate out the network independant parts
of the checkers that are currently in the network dependent list. For
example, the synopsis checker is only in there as it attempts to connect
to the network to check if packages are a GNU package, and I'm wondering
if that can be avoided.

Anyway, hopefully the code refactoring is generally helpful, and maybe
the --no-network option for guix lint will come in useful as well.

Chris

Subject: [PATCH] scripts: lint: Handle warnings with a record type.
From: Christopher Baines <[email-masked]>
To: [email-masked]
Date: Sat, 18 May 2019 10:32:06 +0100
List-Id: <debbugs-submit.debbugs.gnu.org>

Rather than emiting warnings directly to a port, have the checkers return the
warning or warnings.

This makes it easier to use the warnings in different ways, for example,
loading the data in to a database, as you can work with the <lint-warning>
records directly, rather than having to parse the output to determine the
package and location.
---
 guix/scripts/lint.scm |  544 +++++++++-------
 tests/lint.scm        | 1436 +++++++++++++++++++----------------------
 2 files changed, 974 insertions(+), 1006 deletions(-)

diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index dc338a1d7b..37b17cefb4 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -84,6 +84,14 @@
             check-formatting
             run-checkers
 
+            <lint-warning>
+            lint-warning
+            lint-warning-package
+            lint-warning-message
+            lint-warning-location
+
+            append-warnings
+
             %checkers
             lint-checker
             lint-checker?
@@ -93,42 +101,65 @@
 
 
 ;;;
-;;; Helpers
+;;; Warnings
 ;;;
-(define* (emit-warning package message #:optional field)
+
+(define-record-type* <lint-warning>
+  lint-warning make-lint-warning
+  lint-warning?
+  (package  lint-warning-package)
+  (message  lint-warning-message)
+  (location lint-warning-location
+            (default #f)))
+
+(define (package-file package)
+  (location-file
+   (package-location package)))
+
+(define* (make-warning package message
+                       #:key field location)
+  (make-lint-warning
+   package
+   message
+   (or location
+       (package-field-location package field)
+       (package-location package))))
+
+(define (emit-warnings warnings)
   ;; Emit a warning about PACKAGE, printing the location of FIELD if it is
   ;; given, the location of PACKAGE otherwise, the full name of PACKAGE and the
   ;; provided MESSAGE.
-  (let ((loc (or (package-field-location package field)
-                 (package-location package))))
-    (format (guix-warning-port) "~a: ~a@~a: ~a~%"
-            (location->string loc)
-            (package-name package) (package-version package)
-            message)))
-
-(define (call-with-accumulated-warnings thunk)
-  "Call THUNK, accumulating any warnings in the current state, using the state
-monad."
-  (let ((port (open-output-string)))
-    (mlet %state-monad ((state      (current-state))
-                        (result ->  (parameterize ((guix-warning-port port))
-                                      (thunk)))
-                        (warning -> (get-output-string port)))
-      (mbegin %state-monad
-        (munless (string=? "" warning)
-          (set-current-state (cons warning state)))
-        (return result)))))
-
-(define-syntax-rule (with-accumulated-warnings exp ...)
-  "Evaluate EXP and accumulate warnings in the state monad."
-  (call-with-accumulated-warnings
-   (lambda ()
-     exp ...)))
+  (for-each
+   (match-lambda
+     (($ <lint-warning> package message loc)
+      (format (guix-warning-port) "~a: ~a@~a: ~a~%"
+              (location->string loc)
+              (package-name package) (package-version package)
+              message)))
+   (match warnings
+     ((? lint-warning?) (list warnings))
+     ((? list?) (apply append-warnings warnings))
+     (_ '()))))
+
+(define (append-warnings . args)
+  (fold (lambda (arg warnings)
+          (cond
+           ((list? arg)
+            (append warnings
+                    (filter lint-warning?
+                            arg)))
+           ((lint-warning? arg)
+            (append warnings
+                    (list arg)))
+           (else warnings)))
+        '()
+        args))
 
 
 ;;;
 ;;; Checkers
 ;;;
+
 (define-record-type* <lint-checker>
   lint-checker make-lint-checker
   lint-checker?
@@ -164,9 +195,9 @@ monad."
   ;; Emit a warning if stylistic issues are found in the description of PACKAGE.
   (define (check-not-empty description)
     (when (string-null? description)
-      (emit-warning package
+      (make-warning package
                     (G_ "description should not be empty")
-                    'description)))
+                    #:field 'description)))
 
   (define (check-texinfo-markup description)
     "Check that DESCRIPTION can be parsed as a Texinfo fragment.  If the
@@ -174,39 +205,39 @@ markup is valid return a plain-text version of DESCRIPTION, otherwise #f."
     (catch #t
       (lambda () (texi->plain-text description))
       (lambda (keys . args)
-        (emit-warning package
+        (make-warning package
                       (G_ "Texinfo markup in description is invalid")
-                      'description)
-        #f)))
+                      #:field 'description))))
 
   (define (check-trademarks description)
     "Check that DESCRIPTION does not contain '™' or '®' characters.  See
 http://www.gnu.org/prep/standards/html_node/Trademarks.html."
     (match (string-index description (char-set #\™ #\®))
       ((and (? number?) index)
-       (emit-warning package
+       (make-warning package
                      (format #f (G_ "description should not contain ~
 trademark sign '~a' at ~d")
                              (string-ref description index) index)
-                     'description))
+                     #:field 'description))
       (else #t)))
 
   (define (check-quotes description)
     "Check whether DESCRIPTION contains single quotes and suggest @code."
     (when (regexp-exec %quoted-identifier-rx description)
-      (emit-warning package
-
+      (make-warning package
                     ;; TRANSLATORS: '@code' is Texinfo markup and must be kept
                     ;; as is.
                     (G_ "use @code or similar ornament instead of quotes")
-                    'description)))
+                    #:field 'description)))
 
   (define (check-proper-start description)
-    (unless (or (properly-starts-sentence? description)
+    (unless (or (string-null? description)
+                (properly-starts-sentence? description)
                 (string-prefix-ci? (package-name package) description))
-      (emit-warning package
-                    (G_ "description should start with an upper-case letter or digit")
-                    'description)))
+      (make-warning
+       package
+       (G_ "description should start with an upper-case letter or digit")
+       #:field 'description)))
 
   (define (check-end-of-sentence-space description)
     "Check that an end-of-sentence period is followed by two spaces."
@@ -220,27 +251,30 @@ trademark sign '~a' at ~d")
                                  '("i.e" "e.g" "a.k.a" "resp"))
                            r (cons (match:start m) r)))))))
       (unless (null? infractions)
-        (emit-warning package
+        (make-warning package
                       (format #f (G_ "sentences in description should be followed ~
 by two spaces; possible infraction~p at ~{~a~^, ~}")
                               (length infractions)
                               infractions)
-                      'description))))
+                      #:field 'description))))
 
   (let ((description (package-description package)))
     (if (string? description)
-        (begin
-          (check-not-empty description)
-          (check-quotes description)
-          (check-trademarks 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
+        (append-warnings
+         (check-not-empty description)
+         (check-quotes description)
+         (check-trademarks 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)
+                (match-lambda
+                  ((and warning (? lint-warning?)) warning)
+                  (description
+                   (check-proper-start description)))))
+        (make-warning package
                       (format #f (G_ "invalid description: ~s") description)
-                      'description))))
+                      #:field 'description))))
 
 (define (package-input-intersection inputs-to-check input-names)
   "Return the intersection between INPUTS-TO-CHECK, the list of input tuples
@@ -281,13 +315,13 @@ of a package, and INPUT-NAMES, a list of package specifications such as
             "python-pytest-cov" "python2-pytest-cov"
             "python-setuptools-scm" "python2-setuptools-scm"
             "python-sphinx" "python2-sphinx")))
-    (for-each (lambda (input)
-                (emit-warning
-                 package
-                 (format #f (G_ "'~a' should probably be a native input")
-                         input)
-                 'inputs-to-check))
-              (package-input-intersection inputs input-names))))
+    (map (lambda (input)
+           (make-warning
+            package
+            (format #f (G_ "'~a' should probably be a native input")
+                    input)
+            #:field 'inputs))
+         (package-input-intersection inputs input-names))))
 
 (define (check-inputs-should-not-be-an-input-at-all package)
   ;; Emit a warning if some inputs of PACKAGE are likely to should not be
@@ -296,14 +330,15 @@ of a package, and INPUT-NAMES, a list of package specifications such as
                        "python2-setuptools"
                        "python-pip"
                        "python2-pip")))
-    (for-each (lambda (input)
-                (emit-warning
-                 package
-                 (format #f
-                         (G_ "'~a' should probably not be an input at all")
-                         input)))
-              (package-input-intersection (package-direct-inputs package)
-                                          input-names))))
+    (map (lambda (input)
+           (make-warning
+            package
+            (format #f
+                    (G_ "'~a' should probably not be an input at all")
+                    input)
+            #:field 'inputs))
+         (package-input-intersection (package-direct-inputs package)
+                                     input-names))))
 
 (define (package-name-regexp package)
   "Return a regexp that matches PACKAGE's name as a word at the beginning of a
@@ -314,19 +349,13 @@ line."
 
 (define (check-synopsis-style package)
   ;; Emit a warning if stylistic issues are found in the synopsis of PACKAGE.
-  (define (check-not-empty synopsis)
-    (when (string-null? synopsis)
-      (emit-warning package
-                    (G_ "synopsis should not be empty")
-                    'synopsis)))
-
   (define (check-final-period synopsis)
     ;; Synopsis should not end with a period, except for some special cases.
     (when (and (string-suffix? "." synopsis)
                (not (string-suffix? "etc." synopsis)))
-      (emit-warning package
+      (make-warning package
                     (G_ "no period allowed at the end of the synopsis")
-                    'synopsis)))
+                    #:field 'synopsis)))
 
   (define check-start-article
     ;; Skip this check for GNU packages, as suggested by Karl Berry's reply to
@@ -336,29 +365,29 @@ line."
         (lambda (synopsis)
           (when (or (string-prefix-ci? "A " synopsis)
                     (string-prefix-ci? "An " synopsis))
-            (emit-warning package
+            (make-warning package
                           (G_ "no article allowed at the beginning of \
 the synopsis")
-                          'synopsis)))))
+                          #:field 'synopsis)))))
 
   (define (check-synopsis-length synopsis)
     (when (>= (string-length synopsis) 80)
-      (emit-warning package
+      (make-warning package
                     (G_ "synopsis should be less than 80 characters long")
-                    'synopsis)))
+                    #:field 'synopsis)))
 
   (define (check-proper-start synopsis)
     (unless (properly-starts-sentence? synopsis)
-      (emit-warning package
+      (make-warning package
                     (G_ "synopsis should start with an upper-case letter or digit")
-                    'synopsis)))
+                    #:field 'synopsis)))
 
   (define (check-start-with-package-name synopsis)
     (when (and (regexp-exec (package-name-regexp package) synopsis)
                (not (starts-with-abbreviation? synopsis)))
-      (emit-warning package
+      (make-warning package
                     (G_ "synopsis should not start with the package name")
-                    'synopsis)))
+                    #:field 'synopsis)))
 
   (define (check-texinfo-markup synopsis)
     "Check that SYNOPSIS can be parsed as a Texinfo fragment.  If the
@@ -366,14 +395,12 @@ markup is valid return a plain-text version of SYNOPSIS, otherwise #f."
     (catch #t
       (lambda () (texi->plain-text synopsis))
       (lambda (keys . args)
-        (emit-warning package
+        (make-warning package
                       (G_ "Texinfo markup in synopsis is invalid")
-                      'synopsis)
-        #f)))
+                      #:field 'synopsis))))
 
   (define checks
-    (list check-not-empty
-          check-proper-start
+    (list check-proper-start
           check-final-period
           check-start-article
           check-start-with-package-name
@@ -381,13 +408,18 @@ markup is valid return a plain-text version of SYNOPSIS, otherwise #f."
           check-texinfo-markup))
 
   (match (package-synopsis package)
+    (""
+     (make-warning package
+                   (G_ "synopsis should not be empty")
+                   #:field 'synopsis))
     ((? string? synopsis)
-     (for-each (lambda (proc)
-                 (proc synopsis))
-               checks))
+     (apply append-warnings
+            (map (lambda (proc)
+                   (proc synopsis))
+                 checks)))
     (invalid
-     (emit-warning package (format #f (G_ "invalid synopsis: ~s") invalid)
-                   'synopsis))))
+     (make-warning package (format #f (G_ "invalid synopsis: ~s") invalid)
+                   #:field 'synopsis))))
 
 (define* (probe-uri uri #:key timeout)
   "Probe URI, a URI object, and return two values: a symbol denoting the
@@ -502,71 +534,66 @@ warning for PACKAGE mentionning the FIELD."
                  ;; with a small HTML page upon failure.  Attempt to detect
                  ;; such malicious behavior.
                  (or (> length 1000)
-                     (begin
-                       (emit-warning package
-                                     (format #f
-                                             (G_ "URI ~a returned \
+                     (make-warning package
+                                   (format #f
+                                           (G_ "URI ~a returned \
 suspiciously small file (~a bytes)")
-                                             (uri->string uri)
-                                             length))
-                       #f)))
+                                           (uri->string uri)
+                                           length)
+                                   #:field field)))
                 (_ #t)))
              ((= 301 (response-code argument))
               (if (response-location argument)
-                  (begin
-                    (emit-warning package
-                                  (format #f (G_ "permanent redirect from ~a to ~a")
-                                          (uri->string uri)
-                                          (uri->string
-                                           (response-location argument))))
-                    #t)
-                  (begin
-                    (emit-warning package
-                                  (format #f (G_ "invalid permanent redirect \
+                  (make-warning package
+                                (format #f (G_ "permanent redirect from ~a to ~a")
+                                        (uri->string uri)
+                                        (uri->string
+                                         (response-location argument)))
+                                #:field field)
+                  (make-warning package
+                                (format #f (G_ "invalid permanent redirect \
 from ~a")
-                                          (uri->string uri)))
-                    #f)))
+                                        (uri->string uri))
+                                #:field field)))
              (else
-              (emit-warning package
+              (make-warning package
                             (format #f
                                     (G_ "URI ~a not reachable: ~a (~s)")
                                     (uri->string uri)
                                     (response-code argument)
                                     (response-reason-phrase argument))
-                            field)
-              #f)))
+                            #:field field))))
       ((ftp-response)
        (match argument
          (('ok) #t)
          (('error port command code message)
-          (emit-warning package
+          (make-warning package
                         (format #f
                                 (G_ "URI ~a not reachable: ~a (~s)")
                                 (uri->string uri)
-                                code (string-trim-both message)))
-          #f)))
+                                code (string-trim-both message))
+                        #:field field))))
       ((getaddrinfo-error)
-       (emit-warning package
+       (make-warning package
                      (format #f
                              (G_ "URI ~a domain not found: ~a")
                              (uri->string uri)
                              (gai-strerror (car argument)))
-                     field)
-       #f)
+                     #:field field))
       ((system-error)
-       (emit-warning package
+       (make-warning package
                      (format #f
                              (G_ "URI ~a unreachable: ~a")
                              (uri->string uri)
                              (strerror
                               (system-error-errno
                                (cons status argument))))
-                     field)
-       #f)
+                     #:field field))
       ((tls-certificate-error)
-       (emit-warning package
+       (make-warning package
                      (format #f (G_ "TLS certificate error: ~a")
-                             (tls-certificate-error-string argument))))
+                             (tls-certificate-error-string argument))
+                     #:field field))
       ((invalid-http-response gnutls-error)
        ;; Probably a misbehaving server; ignore.
        #f)
@@ -585,13 +612,13 @@ from ~a")
      ((not (package-home-page package))
       (unless (or (string-contains (package-name package) "bootstrap")
                   (string=? (package-name package) "ld-wrapper"))
-        (emit-warning package
+        (make-warning package
                       (G_ "invalid value for home page")
-                      'home-page)))
+                      #:field 'home-page)))
      (else
-      (emit-warning package (format #f (G_ "invalid home page URL: ~s")
+      (make-warning package (format #f (G_ "invalid home page URL: ~s")
                                     (package-home-page package))
-                    'home-page)))))
+                    #:field 'home-page)))))
 
 (define %distro-directory
   (mlambda ()
@@ -601,42 +628,43 @@ from ~a")
   "Emit a warning if the patches requires by PACKAGE are badly named or if the
 patch could not be found."
   (guard (c ((message-condition? c)     ;raised by 'search-patch'
-             (emit-warning package (condition-message c)
-                           'patch-file-names)))
+             (make-warning package (condition-message c)
+                           #:field 'patch-file-names)))
     (define patches
       (or (and=> (package-source package) origin-patches)
           '()))
 
-    (unless (every (match-lambda        ;patch starts with package name?
+    (append-warnings
+     (unless (every (match-lambda        ;patch starts with package name?
+                      ((? string? patch)
+                       (and=> (string-contains (basename patch)
+                                               (package-name package))
+                              zero?))
+                      (_  #f))     ;must be an <origin> or something like that.
+                    patches)
+       (make-warning
+        package
+        (G_ "file names of patches should start with the package name")
+        #:field 'patch-file-names))
+
+     ;; Check whether we're reaching tar's maximum file name length.
+     (let ((prefix (string-length (%distro-directory)))
+           (margin (string-length "guix-0.13.0-10-123456789/"))
+           (max    99))
+       (filter-map (match-lambda
                      ((? string? patch)
-                      (and=> (string-contains (basename patch)
-                                              (package-name package))
-                             zero?))
-                     (_  #f))     ;must be an <origin> or something like that.
-                   patches)
-      (emit-warning
-       package
-       (G_ "file names of patches should start with the package name")
-       'patch-file-names))
-
-    ;; Check whether we're reaching tar's maximum file name length.
-    (let ((prefix (string-length (%distro-directory)))
-          (margin (string-length "guix-0.13.0-10-123456789/"))
-          (max    99))
-      (for-each (match-lambda
-                  ((? string? patch)
-                   (when (> (+ margin (if (string-prefix? (%distro-directory)
-                                                          patch)
-                                          (- (string-length patch) prefix)
-                                          (string-length patch)))
-                            max)
-                     (emit-warning
-                      package
-                      (format #f (G_ "~a: file name is too long")
-                              (basename patch))
-                      'patch-file-names)))
-                  (_ #f))
-                patches))))
+                      (when (> (+ margin (if (string-prefix? (%distro-directory)
+                                                             patch)
+                                             (- (string-length patch) prefix)
+                                             (string-length patch)))
+                               max)
+                        (make-warning
+                         package
+                         (format #f (G_ "~a: file name is too long")
+                                 (basename patch))
+                         #:field 'patch-file-names)))
+                     (_ #f))
+                   patches)))))
 
 (define (escape-quotes str)
   "Replace any quote character in STR by an escaped quote character."
@@ -665,30 +693,29 @@ descriptions maintained upstream."
     (#f                                   ;not a GNU package, so nothing to do
      #t)
     (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))))
-       (when (and upstream
-                  (or (not (string? downstream))
-                      (not (string=? upstream downstream))))
-         (format (guix-warning-port)
-                 (G_ "~a: ~a: proposed synopsis: ~s~%")
-                 (location->string loc) (package-full-name package)
-                 upstream)))
-
-     (let ((upstream   (gnu-package-doc-description descriptor))
-           (downstream (package-description package))
-           (loc        (or (package-field-location package 'description)
-                           (package-location package))))
-       (when (and upstream
-                  (or (not (string? downstream))
-                      (not (string=? (fill-paragraph upstream 100)
-                                     (fill-paragraph downstream 100)))))
-         (format (guix-warning-port)
-                 (G_ "~a: ~a: proposed description:~%     \"~a\"~%")
-                 (location->string loc) (package-full-name package)
-                 (fill-paragraph (escape-quotes upstream) 77 7)))))))
+     (list
+      (let ((upstream   (gnu-package-doc-summary descriptor))
+            (downstream (package-synopsis package)))
+        (when (and upstream
+                   (or (not (string? downstream))
+                       (not (string=? upstream downstream))))
+          (make-warning package
+                        (format #f (G_ "proposed synopsis: ~s~%")
+                                upstream)
+                        #:field 'synopsis)))
+
+      (let ((upstream   (gnu-package-doc-description descriptor))
+            (downstream (package-description package)))
+        (when (and upstream
+                   (or (not (string? downstream))
+                       (not (string=? (fill-paragraph upstream 100)
+                                      (fill-paragraph downstream 100)))))
+          (make-warning
+           package
+           (format #f
+                   (G_ "proposed description:~%     \"~a\"~%")
+                   (fill-paragraph (escape-quotes upstream) 77 7))
+           #:field 'description)))))))
 
 (define (origin-uris origin)
   "Return the list of URIs (strings) for ORIGIN."
@@ -701,38 +728,34 @@ descriptions maintained upstream."
 (define (check-source package)
   "Emit a warning if PACKAGE has an invalid 'source' field, or if that
 'source' is not reachable."
-  (define (try-uris uris)
-    (run-with-state
-        (anym %state-monad
-              (lambda (uri)
-                (with-accumulated-warnings
-                 (validate-uri uri package 'source)))
-              (append-map (cut maybe-expand-mirrors <> %mirrors)
-                          uris))
-      '()))
+  (define (warnings-for-uris uris)
+    (apply
+     append-warnings
+     (map
+      (lambda (uri)
+        (validate-uri uri package 'source))
+      (append-map (cut maybe-expand-mirrors <> %mirrors)
+                  uris))))
 
   (let ((origin (package-source package)))
     (when (and origin
                (eqv? (origin-method origin) url-fetch))
-      (let ((uris (map string->uri (origin-uris origin))))
+      (let* ((uris (map string->uri (origin-uris origin)))
+             (warnings (warnings-for-uris uris)))
 
         ;; Just make sure that at least one of the URIs is valid.
-        (call-with-values
-            (lambda () (try-uris uris))
-          (lambda (success? warnings)
+        (if (eq? (length uris) (length warnings))
             ;; When everything fails, report all of WARNINGS, otherwise don't
             ;; report anything.
             ;;
             ;; XXX: Ideally we'd still allow warnings to be raised if *some*
             ;; URIs are unreachable, but distinguish that from the error case
             ;; where *all* the URIs are unreachable.
-            (unless success?
-              (emit-warning package
-                            (G_ "all the source URIs are unreachable:")
-                            'source)
-              (for-each (lambda (warning)
-                          (display warning (guix-warning-port)))
-                        (reverse warnings)))))))))
+            (cons*
+             (make-warning package
+                           (G_ "all the source URIs are unreachable:")
+                           #:field 'source)
+             warnings))))))
 
 (define (check-source-file-name package)
   "Emit a warning if PACKAGE's origin has no meaningful file name."
@@ -749,9 +772,9 @@ descriptions maintained upstream."
 
   (let ((origin (package-source package)))
     (unless (or (not origin) (origin-file-name-valid? origin))
-      (emit-warning package
+      (make-warning package
                     (G_ "the source file name should contain the package name")
-                    'source))))
+                    #:field 'source))))
 
 (define (check-source-unstable-tarball package)
   "Emit a warning if PACKAGE's source is an autogenerated tarball."
@@ -761,14 +784,14 @@ descriptions maintained upstream."
                                    (uri-path (string->uri uri)))
                       ((_ _ "archive" _ ...) #t)
                       (_ #f)))
-      (emit-warning package
+      (make-warning package
                     (G_ "the source URI should not be an autogenerated tarball")
-                    'source)))
+                    #:field 'source)))
   (let ((origin (package-source package)))
     (when (and (origin? origin)
                (eqv? (origin-method origin) url-fetch))
       (let ((uris (origin-uris origin)))
-        (for-each check-source-uri uris)))))
+        (filter-map check-source-uri uris)))))
 
 (define (check-mirror-url package)
   "Check whether PACKAGE uses source URLs that should be 'mirror://'."
@@ -782,18 +805,18 @@ descriptions maintained upstream."
            (#f
             (loop rest))
            (prefix
-            (emit-warning package
+            (make-warning package
                           (format #f (G_ "URL should be \
 'mirror://~a/~a'")
                                   mirror-id
                                   (string-drop uri (string-length prefix)))
-                          'source)))))))
+                          #:field 'source)))))))
 
   (let ((origin (package-source package)))
     (when (and (origin? origin)
                (eqv? (origin-method origin) url-fetch))
       (let ((uris (origin-uris origin)))
-        (for-each check-mirror-uri uris)))))
+        (filter-map check-mirror-uri uris)))))
 
 (define* (check-github-url package #:key (timeout 3))
   "Check whether PACKAGE uses source URLs that redirect to GitHub."
@@ -819,15 +842,15 @@ descriptions maintained upstream."
   (let ((origin (package-source package)))
     (when (and (origin? origin)
                (eqv? (origin-method origin) url-fetch))
-      (for-each
+      (filter-map
        (lambda (uri)
          (and=> (follow-redirects-to-github uri)
                 (lambda (github-uri)
                   (unless (string=? github-uri uri)
-                    (emit-warning
+                    (make-warning
                      package
                      (format #f (G_ "URL should be '~a'") github-uri)
-                     'source)))))
+                     #:field 'source)))))
        (origin-uris origin)))))
 
 (define (check-derivation package)
@@ -836,12 +859,12 @@ descriptions maintained upstream."
     (catch #t
       (lambda ()
         (guard (c ((store-protocol-error? c)
-                   (emit-warning package
+                   (make-warning package
                                  (format #f (G_ "failed to create ~a derivation: ~a")
                                          system
                                          (store-protocol-error-message c))))
                   ((message-condition? c)
-                   (emit-warning package
+                   (make-warning package
                                  (format #f (G_ "failed to create ~a derivation: ~a")
                                          system
                                          (condition-message c)))))
@@ -858,11 +881,11 @@ descriptions maintained upstream."
                  (package-derivation store replacement system
                                      #:graft? #f)))))))
       (lambda args
-        (emit-warning package
+        (make-warning package
                       (format #f (G_ "failed to create ~a derivation: ~s")
                               system args)))))
 
-  (for-each try (package-supported-systems package)))
+  (filter-map try (package-supported-systems package)))
 
 (define (check-license package)
   "Warn about type errors of the 'license' field of PACKAGE."
@@ -871,8 +894,8 @@ descriptions maintained upstream."
          ((? license?) ...))
      #t)
     (x
-     (emit-warning package (G_ "invalid license field")
-                   'license))))
+     (make-warning package (G_ "invalid license field")
+                   #:field 'license))))
 
 (define (call-with-networking-fail-safe message error-value proc)
   "Call PROC catching any network-related errors.  Upon a networking error,
@@ -944,10 +967,10 @@ the NIST server non-fatal."
                                          (member id known-safe))))
                                  vulnerabilities)))
          (unless (null? unpatched)
-           (emit-warning package
-                         (format #f (G_ "probably vulnerable to ~a")
-                                 (string-join (map vulnerability-id unpatched)
-                                              ", ")))))))))
+           (make-warning package
+                              (format #f (G_ "probably vulnerable to ~a")
+                                      (string-join (map vulnerability-id unpatched)
+                                                   ", ")))))))))
 
 (define (check-for-updates package)
   "Check if there is an update available for PACKAGE."
@@ -959,9 +982,10 @@ the NIST server non-fatal."
     ((? upstream-source? source)
      (when (version>? (upstream-source-version source)
                       (package-version package))
-       (emit-warning package
+       (make-warning package
                      (format #f (G_ "can be upgraded to ~a")
-                             (upstream-source-version source)))))
+                             (upstream-source-version source))
+                     #:field 'version)))
     (#f #f))) ; cannot find newer upstream release
 
 
@@ -974,18 +998,26 @@ the NIST server non-fatal."
   (match (string-index line #\tab)
     (#f #t)
     (index
-     (emit-warning package
+     (make-warning package
                    (format #f (G_ "tabulation on line ~a, column ~a")
-                           line-number index)))))
+                           line-number index)
+                   #:location
+                   (location (package-file package)
+                             line-number
+                             index)))))
 
 (define (report-trailing-white-space package line line-number)
   "Warn about trailing white space in LINE."
   (unless (or (string=? line (string-trim-right line))
               (string=? line (string #\page)))
-    (emit-warning package
+    (make-warning package
                   (format #f
                           (G_ "trailing white space on line ~a")
-                          line-number))))
+                          line-number)
+                  #:location
+                  (location (package-file package)
+                            line-number
+                            0))))
 
 (define (report-long-line package line line-number)
   "Emit a warning if LINE is too long."
@@ -993,9 +1025,13 @@ the NIST server non-fatal."
   ;; make it hard to fit within that limit and we want to avoid making too
   ;; much noise.
   (when (> (string-length line) 90)
-    (emit-warning package
+    (make-warning package
                   (format #f (G_ "line ~a is way too long (~a characters)")
-                          line-number (string-length line)))))
+                          line-number (string-length line))
+                  #:location
+                  (location (package-file package)
+                            line-number
+                            0))))
 
 (define %hanging-paren-rx
   (make-regexp "^[[:blank:]]*[()]+[[:blank:]]*$"))
@@ -1003,11 +1039,15 @@ the NIST server non-fatal."
 (define (report-lone-parentheses package line line-number)
   "Emit a warning if LINE contains hanging parentheses."
   (when (regexp-exec %hanging-paren-rx line)
-    (emit-warning package
+    (make-warning package
                   (format #f
-                          (G_ "line ~a: parentheses feel lonely, \
+                          (G_ "parentheses feel lonely, \
 move to the previous or next line")
-                          line-number))))
+                          line-number)
+                  #:location
+                  (location (package-file package)
+                            line-number
+                            0))))
 
 (define %formatting-reporters
   ;; List of procedures that report formatting issues.  These are not separate
@@ -1040,20 +1080,25 @@ them for PACKAGE."
   (call-with-input-file file
     (lambda (port)
       (let loop ((line-number 1)
-                 (last-line #f))
+                 (last-line #f)
+                 (warnings '()))
         (let ((line (read-line port)))
-          (or (eof-object? line)
-              (and last-line (> line-number last-line))
+          (if (or (eof-object? line)
+                  (and last-line (> line-number last-line)))
+              warnings
               (if (and (= line-number starting-line)
                        (not last-line))
                   (loop (+ 1 line-number)
-                        (+ 1 (sexp-last-line port)))
-                  (begin
-                    (unless (< line-number starting-line)
-                      (for-each (lambda (report)
+                        (+ 1 (sexp-last-line port))
+                        warnings)
+                  (loop (+ 1 line-number)
+                        last-line
+                        (append-warnings
+                         warnings
+                         (unless (< line-number starting-line)
+                           (map (lambda (report)
                                   (report package line line-number))
-                                reporters))
-                    (loop (+ 1 line-number) last-line)))))))))
+                                reporters)))))))))))
 
 (define (check-formatting package)
   "Check the formatting of the source code of PACKAGE."
@@ -1155,7 +1200,8 @@ or a list thereof")
                           (package-name package) (package-version package)
                           (lint-checker-name checker))
                   (force-output (current-error-port)))
-                ((lint-checker-check checker) package))
+                (emit-warnings
+                 ((lint-checker-check checker) package)))
               checkers)
     (when tty?
       (format (current-error-port) "\x1b[K")
diff --git a/tests/lint.scm b/tests/lint.scm
index dc2b17aeec..7d99090d6b 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -44,7 +44,12 @@
   #:use-module (web server http)
   #:use-module (web response)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 getopt-long)
+  #:use-module (ice-9 pretty-print)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9 gnu)
+  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-64))
 
 ;; Test the linter.
@@ -60,781 +65,705 @@
 (define %long-string
   (make-string 2000 #\a))
 
+(define (string-match-or-error pattern str)
+  (or (string-match pattern str)
+      (error str "did not match" pattern)))
+
 
 (test-begin "lint")
 
-(define (call-with-warnings thunk)
-  (let ((port (open-output-string)))
-    (parameterize ((guix-warning-port port))
-      (thunk))
-    (get-output-string port)))
-
-(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
-                      (let ((pkg (dummy-package "x"
-                                   (description ""))))
-                        (check-description-style pkg)))
-                    "description should not be empty")))
-
-(test-assert "description: valid Texinfo markup"
-  (->bool
-   (string-contains
-    (with-warnings
-      (check-description-style (dummy-package "x" (description "f{oo}b@r"))))
-    "Texinfo markup in description is invalid")))
-
-(test-assert "description: does not start with an upper-case letter"
-  (->bool
-   (string-contains (with-warnings
-                      (let ((pkg (dummy-package "x"
+(test-equal "description: not a string"
+  "invalid description: foobar"
+  (lint-warning-message
+   (check-description-style
+    (dummy-package "x" (description 'foobar)))))
+
+(test-equal "description: not empty"
+  "description should not be empty"
+  (match (check-description-style
+          (dummy-package "x" (description "")))
+    ((($ <lint-warning> package message location)) message)))
+
+(test-equal "description: invalid Texinfo markup"
+  "Texinfo markup in description is invalid"
+  (match (check-description-style
+          (dummy-package "x" (description "f{oo}b@r")))
+    ((($ <lint-warning> package message location)) message)))
+
+(test-equal "description: does not start with an upper-case letter"
+  "description should start with an upper-case letter or digit"
+  (match (let ((pkg (dummy-package "x"
                                    (description "bad description."))))
-                        (check-description-style pkg)))
-                    "description should start with an upper-case letter")))
-
-(test-assert "description: may start with a digit"
-  (string-null?
-   (with-warnings
-     (let ((pkg (dummy-package "x"
-                  (description "2-component library."))))
-       (check-description-style pkg)))))
-
-(test-assert "description: may start with lower-case package name"
-  (string-null?
-   (with-warnings
-     (let ((pkg (dummy-package "x"
-                  (description "x is a dummy package."))))
-       (check-description-style pkg)))))
-
-(test-assert "description: two spaces after end of sentence"
-  (->bool
-   (string-contains (with-warnings
-                      (let ((pkg (dummy-package "x"
+           (check-description-style pkg))
+    ((($ <lint-warning> package message location)) message)))
+
+(test-equal "description: may start with a digit"
+  '()
+  (append-warnings
+   (let ((pkg (dummy-package "x"
+                             (description "2-component library."))))
+     (check-description-style pkg))))
+
+(test-equal "description: may start with lower-case package name"
+  '()
+  (append-warnings
+   (let ((pkg (dummy-package "x"
+                             (description "x is a dummy package."))))
+     (check-description-style pkg))))
+
+
+(test-equal "description: two spaces after end of sentence"
+  "sentences in description should be followed by two spaces; possible infraction at 3"
+  (match (let ((pkg (dummy-package "x"
                                    (description "Bad. Quite bad."))))
-                        (check-description-style pkg)))
-                    "sentences in description should be followed by two spaces")))
-
-(test-assert "description: end-of-sentence detection with abbreviations"
-  (string-null?
-   (with-warnings
-     (let ((pkg (dummy-package "x"
-                  (description
-                   "E.g. Foo, i.e. Bar resp. Baz (a.k.a. DVD)."))))
-       (check-description-style pkg)))))
-
-(test-assert "description: may not contain trademark signs"
-  (and (->bool
-        (string-contains (with-warnings
-                           (let ((pkg (dummy-package "x"
-                                        (description "Does The Right Thing™"))))
-                             (check-description-style pkg)))
-                         "should not contain trademark sign"))
-       (->bool
-        (string-contains (with-warnings
-                           (let ((pkg (dummy-package "x"
-                                        (description "Works with Format®"))))
-                             (check-description-style pkg)))
-                         "should not contain trademark sign"))))
-
-(test-assert "description: suggest ornament instead of quotes"
-  (->bool
-   (string-contains (with-warnings
-                      (let ((pkg (dummy-package "x"
+           (check-description-style pkg))
+    ((($ <lint-warning> package message location)) message)))
+
+(test-equal "description: end-of-sentence detection with abbreviations"
+  '()
+  (append-warnings
+   (let ((pkg (dummy-package "x"
+                             (description
+                              "E.g. Foo, i.e. Bar resp. Baz (a.k.a. DVD)."))))
+     (check-description-style pkg))))
+
+(test-equal "description: may not contain trademark signs: ™"
+  "description should not contain trademark sign '™' at 20"
+  (match (let ((pkg (dummy-package "x"
+                                   (description "Does The Right Thing™"))))
+           (check-description-style pkg))
+    ((($ <lint-warning> package message location)) message)))
+
+(test-equal "description: may not contain trademark signs: ®"
+  "description should not contain trademark sign '®' at 17"
+  (match (let ((pkg (dummy-package "x"
+                                   (description "Works with Format®"))))
+           (check-description-style pkg))
+    ((($ <lint-warning> package message location)) message)))
+
+(test-equal "description: suggest ornament instead of quotes"
+  "use @code or similar ornament instead of quotes"
+  (match (let ((pkg (dummy-package "x"
                                    (description "This is a 'quoted' thing."))))
-                        (check-description-style pkg)))
-                    "use @code")))
+           (check-description-style pkg))
+    ((($ <lint-warning> package message location)) message)))
 
-(test-assert "synopsis: not a string"
-  (->bool
-   (string-contains (with-warnings
-                      (let ((pkg (dummy-package "x"
+(test-equal "synopsis: not a string"
+  "invalid synopsis: #f"
+  (match (let ((pkg (dummy-package "x"
                                    (synopsis #f))))
-                        (check-synopsis-style pkg)))
-                    "invalid synopsis")))
+           (append-warnings (check-synopsis-style pkg)))
+    ((($ <lint-warning> package message location)) message)))
 
-(test-assert "synopsis: not empty"
-  (->bool
-   (string-contains (with-warnings
-                      (let ((pkg (dummy-package "x"
+(test-equal "synopsis: not empty"
+  "synopsis should not be empty"
+  (match (let ((pkg (dummy-package "x"
                                    (synopsis ""))))
-                        (check-synopsis-style pkg)))
-                    "synopsis should not be empty")))
-
-(test-assert "synopsis: valid Texinfo markup"
-  (->bool
-   (string-contains
-    (with-warnings
-      (check-synopsis-style (dummy-package "x" (synopsis "Bad $@ texinfo"))))
-    "Texinfo markup in synopsis is invalid")))
-
-(test-assert "synopsis: does not start with an upper-case letter"
-  (->bool
-   (string-contains (with-warnings
-                      (let ((pkg (dummy-package "x"
-                                   (synopsis "bad synopsis."))))
-                        (check-synopsis-style pkg)))
-                    "synopsis should start with an upper-case letter")))
-
-(test-assert "synopsis: may start with a digit"
-  (string-null?
-   (with-warnings
-     (let ((pkg (dummy-package "x"
-                  (synopsis "5-dimensional frobnicator"))))
-       (check-synopsis-style pkg)))))
-
-(test-assert "synopsis: ends with a period"
-  (->bool
-   (string-contains (with-warnings
-                      (let ((pkg (dummy-package "x"
+           (check-synopsis-style pkg))
+    (($ <lint-warning> package message location) message)))
+
+(test-equal "synopsis: valid Texinfo markup"
+  "Texinfo markup in synopsis is invalid"
+  (match (check-synopsis-style
+          (dummy-package "x" (synopsis "Bad $@ texinfo")))
+    ((($ <lint-warning> package message location)) message)))
+
+(test-equal "synopsis: does not start with an upper-case letter"
+  "synopsis should start with an upper-case letter or digit"
+  (match (let ((pkg (dummy-package "x"
+                                   (synopsis "bad synopsis"))))
+           (check-synopsis-style pkg))
+    ((($ <lint-warning> package message location)) message)))
+
+(test-equal "synopsis: may start with a digit"
+  '()
+  (let ((pkg (dummy-package "x"
+                            (synopsis "5-dimensional frobnicator"))))
+    (check-synopsis-style pkg)))
+
+(test-equal "synopsis: ends with a period"
+  "no period allowed at the end of the synopsis"
+  (match (let ((pkg (dummy-package "x"
                                    (synopsis "Bad synopsis."))))
-                        (check-synopsis-style pkg)))
-                    "no period allowed at the end of the synopsis")))
-
-(test-assert "synopsis: ends with 'etc.'"
-  (string-null? (with-warnings
-                  (let ((pkg (dummy-package "x"
-                               (synopsis "Foo, bar, etc."))))
-                    (check-synopsis-style pkg)))))
-
-(test-assert "synopsis: starts with 'A'"
-  (->bool
-   (string-contains (with-warnings
-                      (let ((pkg (dummy-package "x"
+           (check-synopsis-style pkg))
+    ((($ <lint-warning> package message location)) message)))
+
+(test-equal "synopsis: ends with 'etc.'"
+  '()
+  (let ((pkg (dummy-package "x"
+                            (synopsis "Foo, bar, etc."))))
+    (check-synopsis-style pkg)))
+
+(test-equal "synopsis: starts with 'A'"
+  "no article allowed at the beginning of the synopsis"
+  (match (let ((pkg (dummy-package "x"
                                    (synopsis "A bad synopŝis"))))
-                        (check-synopsis-style pkg)))
-                    "no article allowed at the beginning of the synopsis")))
+           (check-synopsis-style pkg))
+    ((($ <lint-warning> package message location)) message)))
 
-(test-assert "synopsis: starts with 'An'"
-  (->bool
-   (string-contains (with-warnings
-                      (let ((pkg (dummy-package "x"
+(test-equal "synopsis: starts with 'An'"
+  "no article allowed at the beginning of the synopsis"
+  (match (let ((pkg (dummy-package "x"
                                    (synopsis "An awful synopsis"))))
-                        (check-synopsis-style pkg)))
-                    "no article allowed at the beginning of the synopsis")))
-
-(test-assert "synopsis: starts with 'a'"
-  (->bool
-   (string-contains (with-warnings
-                      (let ((pkg (dummy-package "x"
-                                   (synopsis "a bad synopsis"))))
-                        (check-synopsis-style pkg)))
-                    "no article allowed at the beginning of the synopsis")))
-
-(test-assert "synopsis: starts with 'an'"
-  (->bool
-   (string-contains (with-warnings
-                      (let ((pkg (dummy-package "x"
-                                   (synopsis "an awful synopsis"))))
-                        (check-synopsis-style pkg)))
-                    "no article allowed at the beginning of the synopsis")))
-
-(test-assert "synopsis: too long"
-  (->bool
-   (string-contains (with-warnings
-                      (let ((pkg (dummy-package "x"
-                                   (synopsis (make-string 80 #\x)))))
-                        (check-synopsis-style pkg)))
-                    "synopsis should be less than 80 characters long")))
-
-(test-assert "synopsis: start with package name"
-  (->bool
-   (string-contains (with-warnings
-                      (let ((pkg (dummy-package "x"
-                                   (name "foo")
-                                   (synopsis "foo, a nice package"))))
-                        (check-synopsis-style pkg)))
-                    "synopsis should not start with the package name")))
-
-(test-assert "synopsis: start with package name prefix"
-  (string-null?
-   (with-warnings
-     (let ((pkg (dummy-package "arb"
-                  (synopsis "Arbitrary precision"))))
-       (check-synopsis-style pkg)))))
-
-(test-assert "synopsis: start with abbreviation"
-  (string-null?
-   (with-warnings
-     (let ((pkg (dummy-package "uucp"
-                  ;; Same problem with "APL interpreter", etc.
-                  (synopsis "UUCP implementation")
-                  (description "Imagine this is Taylor UUCP."))))
-       (check-synopsis-style pkg)))))
-
-(test-assert "inputs: pkg-config is probably a native input"
-  (->bool
-   (string-contains
-     (with-warnings
-       (let ((pkg (dummy-package "x"
-                    (inputs `(("pkg-config" ,pkg-config))))))
-         (check-inputs-should-be-native pkg)))
-         "'pkg-config' should probably be a native input")))
-
-(test-assert "inputs: glib:bin is probably a native input"
-  (->bool
-    (string-contains
-      (with-warnings
-        (let ((pkg (dummy-package "x"
-                     (inputs `(("glib" ,glib "bin"))))))
-          (check-inputs-should-be-native pkg)))
-          "'glib:bin' should probably be a native input")))
-
-(test-assert
+           (check-synopsis-style pkg))
+    ((($ <lint-warning> package message location)) message)))
+
+(test-equal "synopsis: starts with 'a'"
+  '("no article allowed at the beginning of the synopsis"
+    "synopsis should start with an upper-case letter or digit")
+  (sort
+   (map
+    lint-warning-message
+    (let ((pkg (dummy-package "x"
+                              (synopsis "a bad synopsis"))))
+      (check-synopsis-style pkg)))
+   string<?))
+
+(test-equal "synopsis: starts with 'an'"
+  '("no article allowed at the beginning of the synopsis"
+    "synopsis should start with an upper-case letter or digit")
+  (sort
+   (map
+    lint-warning-message
+    (let ((pkg (dummy-package "x"
+                              (synopsis "an awful synopsis"))))
+      (check-synopsis-style pkg)))
+   string<?))
+
+(test-equal "synopsis: too long"
+  "synopsis should be less than 80 characters long"
+  (match (let ((pkg (dummy-package "x"
+                                   (synopsis (make-string 80 #\X)))))
+           (check-synopsis-style pkg))
+    ((($ <lint-warning> package message location)) message)))
+
+(test-equal "synopsis: start with package name"
+  "synopsis should not start with the package name"
+  (match (let ((pkg (dummy-package "x"
+                                   (name "Foo")
+                                   (synopsis "Foo, a nice package"))))
+           (check-synopsis-style pkg))
+    ((($ <lint-warning> package message location)) message)))
+
+(test-equal "synopsis: start with package name prefix"
+  '()
+  (let ((pkg (dummy-package "arb"
+                            (synopsis "Arbitrary precision"))))
+    (check-synopsis-style pkg)))
+
+(test-equal "synopsis: start with abbreviation"
+  '()
+  (let ((pkg (dummy-package "uucp"
+                            ;; Same problem with "APL interpreter", etc.
+                            (synopsis "UUCP implementation")
+                            (description "Imagine this is Taylor UUCP."))))
+    (check-synopsis-style pkg)))
+
+(test-equal "inputs: pkg-config is probably a native input"
+  "'pkg-config' should probably be a native input"
+  (match (let ((pkg (dummy-package "x"
+                                   (inputs `(("pkg-config" ,pkg-config))))))
+           (check-inputs-should-be-native pkg))
+    ((($ <lint-warning> package message location)) message)))
+
+(test-equal "inputs: glib:bin is probably a native input"
+  "'glib:bin' should probably be a native input"
+  (match (let ((pkg (dummy-package "x"
+                                   (inputs `(("glib" ,glib "bin"))))))
+           (check-inputs-should-be-native pkg))
+    ((($ <lint-warning> package message location)) message)))
+
+(test-equal
     "inputs: python-setuptools should not be an input at all (input)"
-  (->bool
-   (string-contains
-     (with-warnings
-       (let ((pkg (dummy-package "x"
-                    (inputs `(("python-setuptools" ,python-setuptools))))))
-         (check-inputs-should-not-be-an-input-at-all pkg)))
-         "'python-setuptools' should probably not be an input at all")))
-
-(test-assert
+  "'python-setuptools' should probably not be an input at all"
+  (match (let ((pkg (dummy-package "x"
+                                   (inputs `(("python-setuptools"
+                                              ,python-setuptools))))))
+           (check-inputs-should-not-be-an-input-at-all pkg))
+    ((($ <lint-warning> package message location)) message)))
+
+
+(test-equal
     "inputs: python-setuptools should not be an input at all (native-input)"
-  (->bool
-   (string-contains
-     (with-warnings
-       (let ((pkg (dummy-package "x"
-                    (native-inputs
-                     `(("python-setuptools" ,python-setuptools))))))
-         (check-inputs-should-not-be-an-input-at-all pkg)))
-         "'python-setuptools' should probably not be an input at all")))
-
-(test-assert
+  "'python-setuptools' should probably not be an input at all"
+  (match (let ((pkg (dummy-package "x"
+                                   (native-inputs
+                                    `(("python-setuptools"
+                                       ,python-setuptools))))))
+           (check-inputs-should-not-be-an-input-at-all pkg))
+    ((($ <lint-warning> package message location)) message)))
+
+(test-equal
     "inputs: python-setuptools should not be an input at all (propagated-input)"
-  (->bool
-   (string-contains
-     (with-warnings
-       (let ((pkg (dummy-package "x"
-                    (propagated-inputs
-                     `(("python-setuptools" ,python-setuptools))))))
-         (check-inputs-should-not-be-an-input-at-all pkg)))
-         "'python-setuptools' should probably not be an input at all")))
-
-(test-assert "patches: file names"
-  (->bool
-   (string-contains
-     (with-warnings
-       (let ((pkg (dummy-package "x"
-                    (source
-                     (dummy-origin
-                       (patches (list "/path/to/y.patch")))))))
-         (check-patch-file-names pkg)))
-     "file names of patches should start with the package name")))
-
-(test-assert "patches: file name too long"
-  (->bool
-   (string-contains
-     (with-warnings
-       (let ((pkg (dummy-package "x"
-                    (source
-                     (dummy-origin
-                      (patches (list (string-append "x-"
-                                                    (make-string 100 #\a)
-                                                    ".patch"))))))))
-         (check-patch-file-names pkg)))
-     "file name is too long")))
-
-(test-assert "patches: not found"
-  (->bool
-   (string-contains
-     (with-warnings
-       (let ((pkg (dummy-package "x"
-                    (source
-                     (dummy-origin
+  "'python-setuptools' should probably not be an input at all"
+  (match (let ((pkg (dummy-package "x"
+                                   (propagated-inputs
+                                    `(("python-setuptools" ,python-setuptools))))))
+           (check-inputs-should-not-be-an-input-at-all pkg))
+    ((($ <lint-warning> package message location)) message)))
+
+(test-equal "patches: file names"
+  "file names of patches should start with the package name"
+  (match (let ((pkg (dummy-package "x"
+                                   (source
+                                    (dummy-origin
+                                     (patches (list "/path/to/y.patch")))))))
+           (check-patch-file-names pkg))
+    ((($ <lint-warning> package message location)) message)))
+
+(test-equal "patches: file name too long"
+  (string-append "x-"
+                 (make-string 100 #\a)
+                 ".patch: file name is too long")
+  (match (let ((pkg (dummy-package
+                     "x"
+                     (source
+                      (dummy-origin
+                       (patches (list (string-append "x-"
+                                                     (make-string 100 #\a)
+                                                     ".patch"))))))))
+           (check-patch-file-names pkg))
+    ((($ <lint-warning> package message location)) message)))
+
+(test-equal "patches: not found"
+  "this-patch-does-not-exist!: patch not found"
+  (match (let ((pkg (dummy-package
+                     "x"
+                     (source
+                      (dummy-origin
                        (patches
                         (list (search-patch "this-patch-does-not-exist!"))))))))
-         (check-patch-file-names pkg)))
-     "patch not found")))
-
-(test-assert "derivation: invalid arguments"
-  (->bool
-   (string-contains
-    (with-warnings
-      (let ((pkg (dummy-package "x"
-                   (arguments
-                    '(#:imported-modules (invalid-module))))))
-        (check-derivation pkg)))
-    "failed to create")))
-
-(test-assert "license: invalid license"
-  (string-contains
-   (with-warnings
-     (check-license (dummy-package "x" (license #f))))
-   "invalid license"))
-
-(test-assert "home-page: wrong home-page"
-  (->bool
-   (string-contains
-    (with-warnings
-      (let ((pkg (package
-                   (inherit (dummy-package "x"))
-                   (home-page #f))))
-        (check-home-page pkg)))
-    "invalid")))
-
-(test-assert "home-page: invalid URI"
-  (->bool
-   (string-contains
-    (with-warnings
-      (let ((pkg (package
-                   (inherit (dummy-package "x"))
-                   (home-page "foobar"))))
-        (check-home-page pkg)))
-    "invalid home page URL")))
-
-(test-assert "home-page: host not found"
-  (->bool
-   (string-contains
-    (with-warnings
-      (let ((pkg (package
-                   (inherit (dummy-package "x"))
-                   (home-page "http://does-not-exist"))))
-        (check-home-page pkg)))
-    "domain not found")))
+           (check-patch-file-names pkg))
+    (($ <lint-warning> package message location) message)))
+
+(test-equal "derivation: invalid arguments"
+  "failed to create x86_64-linux derivation: (wrong-type-arg \"map\" \"Wrong type argument: ~S\" (invalid-module) ())"
+  (match (let ((pkg (dummy-package "x"
+                                   (arguments
+                                    '(#:imported-modules (invalid-module))))))
+           (check-derivation pkg))
+    ((($ <lint-warning> package message location) others ...) message)))
+
+(test-equal "license: invalid license"
+  "invalid license field"
+  (lint-warning-message
+   (check-license (dummy-package "x" (license #f)))))
+
+(test-equal "home-page: wrong home-page"
+  "invalid value for home page"
+  (let ((pkg (package
+               (inherit (dummy-package "x"))
+               (home-page #f))))
+    (lint-warning-message
+     (check-home-page pkg))))
+
+(test-equal "home-page: invalid URI"
+  "invalid home page URL: \"foobar\""
+  (let ((pkg (package
+               (inherit (dummy-package "x"))
+               (home-page "foobar"))))
+    (lint-warning-message
+     (check-home-page pkg))))
+
+(test-equal "home-page: host not found"
+  "URI http://does-not-exist domain not found: Name or service not known"
+  (let ((pkg (package
+               (inherit (dummy-package "x"))
+               (home-page "http://does-not-exist"))))
+    (lint-warning-message
+     (check-home-page pkg))))
 
 (test-skip (if (http-server-can-listen?) 0 1))
-(test-assert "home-page: Connection refused"
-  (->bool
-   (string-contains
-    (with-warnings
-      (let ((pkg (package
-                   (inherit (dummy-package "x"))
-                   (home-page (%local-url)))))
-        (check-home-page pkg)))
-    "Connection refused")))
+(test-equal "home-page: Connection refused"
+  "URI http://localhost:9999/foo/bar unreachable: Connection refused"
+  (let ((pkg (package
+               (inherit (dummy-package "x"))
+               (home-page (%local-url)))))
+    (lint-warning-message
+     (check-home-page pkg))))
 
 (test-skip (if (http-server-can-listen?) 0 1))
 (test-equal "home-page: 200"
-  ""
-  (with-warnings
-   (with-http-server 200 %long-string
-     (let ((pkg (package
-                  (inherit (dummy-package "x"))
-                  (home-page (%local-url)))))
+  '()
+  (with-http-server 200 %long-string
+    (let ((pkg (package
+                 (inherit (dummy-package "x"))
+                 (home-page (%local-url)))))
+      (append-warnings
        (check-home-page pkg)))))
 
 (test-skip (if (http-server-can-listen?) 0 1))
-(test-assert "home-page: 200 but short length"
-  (->bool
-   (string-contains
-    (with-warnings
-      (with-http-server 200 "This is too small."
-        (let ((pkg (package
-                     (inherit (dummy-package "x"))
-                     (home-page (%local-url)))))
-          (check-home-page pkg))))
-    "suspiciously small")))
+(test-equal "home-page: 200 but short length"
+  "URI http://localhost:9999/foo/bar returned suspiciously small file (18 bytes)"
+  (with-http-server 200 "This is too small."
+    (let ((pkg (package
+                 (inherit (dummy-package "x"))
+                 (home-page (%local-url)))))
+
+      (lint-warning-message
+       (check-home-page pkg)))))
 
 (test-skip (if (http-server-can-listen?) 0 1))
-(test-assert "home-page: 404"
-  (->bool
-   (string-contains
-    (with-warnings
-      (with-http-server 404 %long-string
-        (let ((pkg (package
-                     (inherit (dummy-package "x"))
-                     (home-page (%local-url)))))
-          (check-home-page pkg))))
-    "not reachable: 404")))
+(test-equal "home-page: 404"
+  "URI http://localhost:9999/foo/bar not reachable: 404 (\"Such is life\")"
+  (with-http-server 404 %long-string
+    (let ((pkg (package
+                 (inherit (dummy-package "x"))
+                 (home-page (%local-url)))))
+      (lint-warning-message
+       (check-home-page pkg)))))
 
 (test-skip (if (http-server-can-listen?) 0 1))
-(test-assert "home-page: 301, invalid"
-  (->bool
-   (string-contains
-    (with-warnings
-      (with-http-server 301 %long-string
-        (let ((pkg (package
-                     (inherit (dummy-package "x"))
-                     (home-page (%local-url)))))
-          (check-home-page pkg))))
-    "invalid permanent redirect")))
+(test-equal "home-page: 301, invalid"
+  "invalid permanent redirect from http://localhost:9999/foo/bar"
+  (with-http-server 301 %long-string
+    (let ((pkg (package
+                 (inherit (dummy-package "x"))
+                 (home-page (%local-url)))))
+      (lint-warning-message
+       (check-home-page pkg)))))
 
 (test-skip (if (http-server-can-listen?) 0 1))
-(test-assert "home-page: 301 -> 200"
-  (->bool
-   (string-contains
-    (with-warnings
-      (with-http-server 200 %long-string
-        (let ((initial-url (%local-url)))
-          (parameterize ((%http-server-port (+ 1 (%http-server-port))))
-            (with-http-server (301 `((location
-                                      . ,(string->uri initial-url))))
-                ""
-              (let ((pkg (package
-                           (inherit (dummy-package "x"))
-                           (home-page (%local-url)))))
-                (check-home-page pkg)))))))
-    "permanent redirect")))
+(test-equal "home-page: 301 -> 200"
+  "permanent redirect from http://localhost:10000/foo/bar to http://localhost:9999/foo/bar"
+  (with-http-server 200 %long-string
+    (let ((initial-url (%local-url)))
+      (parameterize ((%http-server-port (+ 1 (%http-server-port))))
+        (with-http-server (301 `((location
+                                  . ,(string->uri initial-url))))
+            ""
+          (let ((pkg (package
+                       (inherit (dummy-package "x"))
+                       (home-page (%local-url)))))
+            (lint-warning-message
+             (check-home-page pkg))))))))
 
 (test-skip (if (http-server-can-listen?) 0 1))
-(test-assert "home-page: 301 -> 404"
-  (->bool
-   (string-contains
-    (with-warnings
-      (with-http-server 404 "booh!"
-        (let ((initial-url (%local-url)))
-          (parameterize ((%http-server-port (+ 1 (%http-server-port))))
-            (with-http-server (301 `((location
-                                      . ,(string->uri initial-url))))
-                ""
-              (let ((pkg (package
-                           (inherit (dummy-package "x"))
-                           (home-page (%local-url)))))
-                (check-home-page pkg)))))))
-    "not reachable: 404")))
-
-(test-assert "source-file-name"
-  (->bool
-   (string-contains
-    (with-warnings
-      (let ((pkg (dummy-package "x"
-                   (version "3.2.1")
-                   (source
-                    (origin
-                      (method url-fetch)
-                      (uri "http://www.example.com/3.2.1.tar.gz")
-                      (sha256 %null-sha256))))))
-        (check-source-file-name pkg)))
-    "file name should contain the package name")))
-
-(test-assert "source-file-name: v prefix"
-  (->bool
-   (string-contains
-    (with-warnings
-      (let ((pkg (dummy-package "x"
-                   (version "3.2.1")
-                   (source
-                    (origin
-                      (method url-fetch)
-                      (uri "http://www.example.com/v3.2.1.tar.gz")
-                      (sha256 %null-sha256))))))
-        (check-source-file-name pkg)))
-    "file name should contain the package name")))
-
-(test-assert "source-file-name: bad checkout"
-  (->bool
-   (string-contains
-    (with-warnings
-      (let ((pkg (dummy-package "x"
-                   (version "3.2.1")
-                   (source
-                    (origin
-                      (method git-fetch)
-                      (uri (git-reference
-                            (url "http://www.example.com/x.git")
-                            (commit "0")))
-                      (sha256 %null-sha256))))))
-        (check-source-file-name pkg)))
-    "file name should contain the package name")))
-
-(test-assert "source-file-name: good checkout"
-  (not
-   (->bool
-    (string-contains
-     (with-warnings
-       (let ((pkg (dummy-package "x"
-                    (version "3.2.1")
-                    (source
-                     (origin
-                       (method git-fetch)
-                       (uri (git-reference
-                             (url "http://git.example.com/x.git")
-                             (commit "0")))
-                       (file-name (string-append "x-" version))
-                       (sha256 %null-sha256))))))
-         (check-source-file-name pkg)))
-     "file name should contain the package name"))))
-
-(test-assert "source-file-name: valid"
-  (not
-   (->bool
-    (string-contains
-     (with-warnings
-       (let ((pkg (dummy-package "x"
-                    (version "3.2.1")
-                    (source
-                     (origin
-                       (method url-fetch)
-                       (uri "http://www.example.com/x-3.2.1.tar.gz")
-                       (sha256 %null-sha256))))))
-         (check-source-file-name pkg)))
-     "file name should contain the package name"))))
-
-(test-assert "source-unstable-tarball"
-  (string-contains
-   (with-warnings
-     (let ((pkg (dummy-package "x"
-                  (source
-                    (origin
-                      (method url-fetch)
-                      (uri "https://github.com/example/example/archive/v0.0.tar.gz")
-                      (sha256 %null-sha256))))))
-       (check-source-unstable-tarball pkg)))
-   "source URI should not be an autogenerated tarball"))
-
-(test-assert "source-unstable-tarball: source #f"
-  (not
-    (->bool
-     (string-contains
-      (with-warnings
-        (let ((pkg (dummy-package "x"
-                     (source #f))))
-          (check-source-unstable-tarball pkg)))
-      "source URI should not be an autogenerated tarball"))))
-
-(test-assert "source-unstable-tarball: valid"
-  (not
-    (->bool
-     (string-contains
-      (with-warnings
-        (let ((pkg (dummy-package "x"
-                     (source
-                       (origin
-                         (method url-fetch)
-                         (uri "https://github.com/example/example/releases/download/x-0.0/x-0.0.tar.gz")
-                         (sha256 %null-sha256))))))
-          (check-source-unstable-tarball pkg)))
-      "source URI should not be an autogenerated tarball"))))
-
-(test-assert "source-unstable-tarball: package named archive"
-  (not
-    (->bool
-     (string-contains
-      (with-warnings
-        (let ((pkg (dummy-package "x"
-                     (source
-                       (origin
-                         (method url-fetch)
-                         (uri "https://github.com/example/archive/releases/download/x-0.0/x-0.0.tar.gz")
-                         (sha256 %null-sha256))))))
-          (check-source-unstable-tarball pkg)))
-      "source URI should not be an autogenerated tarball"))))
-
-(test-assert "source-unstable-tarball: not-github"
-  (not
-    (->bool
-     (string-contains
-      (with-warnings
-        (let ((pkg (dummy-package "x"
-                     (source
-                       (origin
-                         (method url-fetch)
-                         (uri "https://bitbucket.org/archive/example/download/x-0.0.tar.gz")
-                         (sha256 %null-sha256))))))
-          (check-source-unstable-tarball pkg)))
-      "source URI should not be an autogenerated tarball"))))
-
-(test-assert "source-unstable-tarball: git-fetch"
-  (not
-    (->bool
-     (string-contains
-      (with-warnings
-        (let ((pkg (dummy-package "x"
-                     (source
-                       (origin
-                         (method git-fetch)
-                         (uri (git-reference
-                                (url "https://github.com/archive/example.git")
-                                (commit "0")))
-                         (sha256 %null-sha256))))))
-          (check-source-unstable-tarball pkg)))
-      "source URI should not be an autogenerated tarball"))))
+(test-equal "home-page: 301 -> 404"
+  "URI http://localhost:10000/foo/bar not reachable: 404 (\"Such is life\")"
+  (with-http-server 404 "booh!"
+    (let ((initial-url (%local-url)))
+      (parameterize ((%http-server-port (+ 1 (%http-server-port))))
+        (with-http-server (301 `((location
+                                  . ,(string->uri initial-url))))
+            ""
+          (let ((pkg (package
+                       (inherit (dummy-package "x"))
+                       (home-page (%local-url)))))
+            (lint-warning-message
+             (check-home-page pkg))))))))
+
+(test-equal "source-file-name"
+  "the source file name should contain the package name"
+  (let ((pkg (dummy-package "x"
+                            (version "3.2.1")
+                            (source
+                             (origin
+                               (method url-fetch)
+                               (uri "http://www.example.com/3.2.1.tar.gz")
+                               (sha256 %null-sha256))))))
+    (lint-warning-message
+     (check-source-file-name pkg))))
+
+(test-equal "source-file-name: v prefix"
+  "the source file name should contain the package name"
+  (let ((pkg (dummy-package "x"
+                            (version "3.2.1")
+                            (source
+                             (origin
+                               (method url-fetch)
+                               (uri "http://www.example.com/v3.2.1.tar.gz")
+                               (sha256 %null-sha256))))))
+    (lint-warning-message
+     (check-source-file-name pkg))))
+
+(test-equal "source-file-name: bad checkout"
+  "the source file name should contain the package name"
+  (let ((pkg (dummy-package "x"
+                            (version "3.2.1")
+                            (source
+                             (origin
+                               (method git-fetch)
+                               (uri (git-reference
+                                     (url "http://www.example.com/x.git")
+                                     (commit "0")))
+                               (sha256 %null-sha256))))))
+    (lint-warning-message
+     (check-source-file-name pkg))))
+
+(test-equal "source-file-name: good checkout"
+  '()
+  (let ((pkg (dummy-package "x"
+                            (version "3.2.1")
+                            (source
+                             (origin
+                               (method git-fetch)
+                               (uri (git-reference
+                                     (url "http://git.example.com/x.git")
+                                     (commit "0")))
+                               (file-name (string-append "x-" version))
+                               (sha256 %null-sha256))))))
+    (append-warnings
+     (check-source-file-name pkg))))
+
+(test-equal "source-file-name: valid"
+  '()
+  (let ((pkg (dummy-package "x"
+                            (version "3.2.1")
+                            (source
+                             (origin
+                               (method url-fetch)
+                               (uri "http://www.example.com/x-3.2.1.tar.gz")
+                               (sha256 %null-sha256))))))
+    (append-warnings
+     (check-source-file-name pkg))))
+
+(test-equal "source-unstable-tarball"
+  "the source URI should not be an autogenerated tarball"
+  (let ((pkg (dummy-package "x"
+                            (source
+                             (origin
+                               (method url-fetch)
+                               (uri "https://github.com/example/example/archive/v0.0.tar.gz")
+                               (sha256 %null-sha256))))))
+    (match (check-source-unstable-tarball pkg)
+      ((($ <lint-warning> package message comment)) message))))
+
+(test-equal "source-unstable-tarball: source #f"
+  '()
+  (let ((pkg (dummy-package "x"
+                            (source #f))))
+    (append-warnings
+     (check-source-unstable-tarball pkg))))
+
+(test-equal "source-unstable-tarball: valid"
+  '()
+  (let ((pkg (dummy-package "x"
+                            (source
+                             (origin
+                               (method url-fetch)
+                               (uri "https://github.com/example/example/releases/download/x-0.0/x-0.0.tar.gz")
+                               (sha256 %null-sha256))))))
+    (append-warnings
+     (check-source-unstable-tarball pkg))))
+
+(test-equal "source-unstable-tarball: package named archive"
+  '()
+  (let ((pkg (dummy-package "x"
+                            (source
+                             (origin
+                               (method url-fetch)
+                               (uri "https://github.com/example/archive/releases/download/x-0.0/x-0.0.tar.gz")
+                               (sha256 %null-sha256))))))
+    (append-warnings
+     (check-source-unstable-tarball pkg))))
+
+(test-equal "source-unstable-tarball: not-github"
+  '()
+  (let ((pkg (dummy-package "x"
+                            (source
+                             (origin
+                               (method url-fetch)
+                               (uri "https://bitbucket.org/archive/example/download/x-0.0.tar.gz")
+                               (sha256 %null-sha256))))))
+    (append-warnings
+     (check-source-unstable-tarball pkg))))
+
+(test-equal "source-unstable-tarball: git-fetch"
+  '()
+  (let ((pkg (dummy-package "x"
+                            (source
+                             (origin
+                               (method git-fetch)
+                               (uri (git-reference
+                                     (url "https://github.com/archive/example.git")
+                                     (commit "0")))
+                               (sha256 %null-sha256))))))
+    (append-warnings
+     (check-source-unstable-tarball pkg))))
 
 (test-skip (if (http-server-can-listen?) 0 1))
 (test-equal "source: 200"
-  ""
-  (with-warnings
-   (with-http-server 200 %long-string
-     (let ((pkg (package
-                  (inherit (dummy-package "x"))
-                  (source (origin
-                            (method url-fetch)
-                            (uri (%local-url))
-                            (sha256 %null-sha256))))))
+  '()
+  (with-http-server 200 %long-string
+    (let ((pkg (package
+                 (inherit (dummy-package "x"))
+                 (source (origin
+                           (method url-fetch)
+                           (uri (%local-url))
+                           (sha256 %null-sha256))))))
+      (append-warnings
        (check-source pkg)))))
 
 (test-skip (if (http-server-can-listen?) 0 1))
-(test-assert "source: 200 but short length"
-  (->bool
-   (string-contains
-    (with-warnings
-      (with-http-server 200 "This is too small."
-        (let ((pkg (package
-                     (inherit (dummy-package "x"))
-                     (source (origin
-                               (method url-fetch)
-                               (uri (%local-url))
-                               (sha256 %null-sha256))))))
-          (check-source pkg))))
-    "suspiciously small")))
+(test-equal "source: 200 but short length"
+  "URI http://localhost:9999/foo/bar returned suspiciously small file (18 bytes)"
+  (with-http-server 200 "This is too small."
+    (let ((pkg (package
+                 (inherit (dummy-package "x"))
+                 (source (origin
+                           (method url-fetch)
+                           (uri (%local-url))
+                           (sha256 %null-sha256))))))
+      (match (check-source pkg)
+        ((first-warning ; All source URIs are unreachable
+          ($ <lint-warning> package message location)) message)))))
 
 (test-skip (if (http-server-can-listen?) 0 1))
-(test-assert "source: 404"
-  (->bool
-   (string-contains
-    (with-warnings
-      (with-http-server 404 %long-string
-        (let ((pkg (package
-                     (inherit (dummy-package "x"))
-                     (source (origin
-                               (method url-fetch)
-                               (uri (%local-url))
-                               (sha256 %null-sha256))))))
-          (check-source pkg))))
-    "not reachable: 404")))
+(test-equal "source: 404"
+  "URI http://localhost:9999/foo/bar not reachable: 404 (\"Such is life\")"
+  (with-http-server 404 %long-string
+    (let ((pkg (package
+                 (inherit (dummy-package "x"))
+                 (source (origin
+                           (method url-fetch)
+                           (uri (%local-url))
+                           (sha256 %null-sha256))))))
+      (match (check-source pkg)
+        ((first-warning ; All source URIs are unreachable
+          ($ <lint-warning> package message location)) message)))))
 
 (test-skip (if (http-server-can-listen?) 0 1))
 (test-equal "source: 301 -> 200"
-  ""
-  (with-warnings
-    (with-http-server 200 %long-string
-      (let ((initial-url (%local-url)))
-        (parameterize ((%http-server-port (+ 1 (%http-server-port))))
-          (with-http-server (301 `((location . ,(string->uri initial-url))))
-              ""
-            (let ((pkg (package
-                         (inherit (dummy-package "x"))
-                         (source (origin
-                                   (method url-fetch)
-                                   (uri (%local-url))
-                                   (sha256 %null-sha256))))))
-              (check-source pkg))))))))
+  "permanent redirect from http://localhost:10000/foo/bar to http://localhost:9999/foo/bar"
+  (with-http-server 200 %long-string
+    (let ((initial-url (%local-url)))
+      (parameterize ((%http-server-port (+ 1 (%http-server-port))))
+        (with-http-server (301 `((location . ,(string->uri initial-url))))
+            ""
+          (let ((pkg (package
+                       (inherit (dummy-package "x"))
+                       (source (origin
+                                 (method url-fetch)
+                                 (uri (%local-url))
+                                 (sha256 %null-sha256))))))
+            (match (check-source pkg)
+              ((first-warning ; All source URIs are unreachable
+                ($ <lint-warning> package message location)) message))))))))
 
 (test-skip (if (http-server-can-listen?) 0 1))
-(test-assert "source: 301 -> 404"
-  (->bool
-   (string-contains
-    (with-warnings
-      (with-http-server 404 "booh!"
-        (let ((initial-url (%local-url)))
-          (parameterize ((%http-server-port (+ 1 (%http-server-port))))
-            (with-http-server (301 `((location . ,(string->uri initial-url))))
-                ""
-              (let ((pkg (package
-                           (inherit (dummy-package "x"))
-                           (source (origin
-                                     (method url-fetch)
-                                     (uri (%local-url))
-                                     (sha256 %null-sha256))))))
-                (check-source pkg)))))))
-    "not reachable: 404")))
-
-(test-assert "mirror-url"
-  (string-null?
-   (with-warnings
-     (let ((source (origin
-                     (method url-fetch)
-                     (uri "http://example.org/foo/bar.tar.gz")
-                     (sha256 %null-sha256))))
-       (check-mirror-url (dummy-package "x" (source source)))))))
-
-(test-assert "mirror-url: one suggestion"
-  (string-contains
-   (with-warnings
-     (let ((source (origin
-                     (method url-fetch)
-                     (uri "http://ftp.gnu.org/pub/gnu/foo/foo.tar.gz")
-                     (sha256 %null-sha256))))
-       (check-mirror-url (dummy-package "x" (source source)))))
-   "mirror://gnu/foo/foo.tar.gz"))
-
-(test-assert "github-url"
-  (string-null?
-   (with-warnings
-     (with-http-server 200 %long-string
-       (check-github-url
-        (dummy-package "x" (source
-                            (origin
-                              (method url-fetch)
-                              (uri (%local-url))
-                              (sha256 %null-sha256)))))))))
+(test-equal "source: 301 -> 404"
+  "URI http://localhost:10000/foo/bar not reachable: 404 (\"Such is life\")"
+  (with-http-server 404 "booh!"
+    (let ((initial-url (%local-url)))
+      (parameterize ((%http-server-port (+ 1 (%http-server-port))))
+        (with-http-server (301 `((location . ,(string->uri initial-url))))
+            ""
+          (let ((pkg (package
+                       (inherit (dummy-package "x"))
+                       (source (origin
+                                 (method url-fetch)
+                                 (uri (%local-url))
+                                 (sha256 %null-sha256))))))
+            (match (check-source pkg)
+              ((first-warning ; The first warning says that all URI's are
+                              ; unreachable
+                ($ <lint-warning> package message location)) message))))))))
+
+(test-equal "mirror-url"
+  '()
+  (let ((source (origin
+                  (method url-fetch)
+                  (uri "http://example.org/foo/bar.tar.gz")
+                  (sha256 %null-sha256))))
+    (append-warnings
+     (check-mirror-url (dummy-package "x" (source source))))))
+
+(test-equal "mirror-url: one suggestion"
+  "URL should be 'mirror://gnu/foo/foo.tar.gz'"
+  (let ((source (origin
+                  (method url-fetch)
+                  (uri "http://ftp.gnu.org/pub/gnu/foo/foo.tar.gz")
+                  (sha256 %null-sha256))))
+    (match (check-mirror-url (dummy-package "x" (source source)))
+      ((($ <lint-warning> package message location)) message))))
+
+(test-equal "github-url"
+  '()
+  (with-http-server 200 %long-string
+    (append-warnings
+     (check-github-url
+      (dummy-package "x" (source
+                          (origin
+                            (method url-fetch)
+                            (uri (%local-url))
+                            (sha256 %null-sha256))))))))
 
 (let ((github-url "https://github.com/foo/bar/bar-1.0.tar.gz"))
-  (test-assert "github-url: one suggestion"
-    (string-contains
-     (with-warnings
-       (with-http-server (301 `((location . ,(string->uri github-url)))) ""
-         (let ((initial-uri (%local-url)))
-           (parameterize ((%http-server-port (+ 1 (%http-server-port))))
-             (with-http-server (302 `((location . ,(string->uri initial-uri)))) ""
-               (check-github-url
-                (dummy-package "x" (source
-                                    (origin
-                                      (method url-fetch)
-                                      (uri (%local-url))
-                                      (sha256 %null-sha256))))))))))
-     github-url))
-  (test-assert "github-url: already the correct github url"
-    (string-null?
-     (with-warnings
-       (check-github-url
-        (dummy-package "x" (source
-                            (origin
-                              (method url-fetch)
-                              (uri github-url)
-                              (sha256 %null-sha256)))))))))
-
-(test-assert "cve"
+  (test-equal "github-url: one suggestion"
+    (string-append
+     "URL should be '" github-url "'")
+    (with-http-server (301 `((location . ,(string->uri github-url)))) ""
+      (let ((initial-uri (%local-url)))
+        (parameterize ((%http-server-port (+ 1 (%http-server-port))))
+          (with-http-server (302 `((location . ,(string->uri initial-uri)))) ""
+            (match (check-github-url
+                    (dummy-package "x" (source
+                                        (origin
+                                          (method url-fetch)
+                                          (uri (%local-url))
+                                          (sha256 %null-sha256)))))
+              ((($ <lint-warning> package message location)) message)))))))
+  (test-equal "github-url: already the correct github url"
+    '()
+    (append-warnings
+     (check-github-url
+      (dummy-package "x" (source
+                          (origin
+                            (method url-fetch)
+                            (uri github-url)
+                            (sha256 %null-sha256))))))))
+
+(test-equal "cve"
+  '()
   (mock ((guix scripts lint) package-vulnerabilities (const '()))
-        (string-null?
-         (with-warnings (check-vulnerabilities (dummy-package "x"))))))
+        (append-warnings
+         (check-vulnerabilities (dummy-package "x")))))
 
-(test-assert "cve: one vulnerability"
+(test-equal "cve: one vulnerability"
+  "probably vulnerable to CVE-2015-1234"
   (mock ((guix scripts lint) package-vulnerabilities
          (lambda (package)
            (list (make-struct (@@ (guix cve) <vulnerability>) 0
                               "CVE-2015-1234"
                               (list (cons (package-name package)
                                           (package-version package)))))))
-        (string-contains
-         (with-warnings
-           (check-vulnerabilities (dummy-package "pi" (version "3.14"))))
-         "vulnerable to CVE-2015-1234")))
+        (match (check-vulnerabilities (dummy-package "pi" (version "3.14")))
+          (($ <lint-warning> package message location) message))))
 
-(test-assert "cve: one patched vulnerability"
+(test-equal "cve: one patched vulnerability"
+  '()
   (mock ((guix scripts lint) package-vulnerabilities
          (lambda (package)
            (list (make-struct (@@ (guix cve) <vulnerability>) 0
                               "CVE-2015-1234"
                               (list (cons (package-name package)
                                           (package-version package)))))))
-        (string-null?
-         (with-warnings
-           (check-vulnerabilities
-            (dummy-package "pi"
-                           (version "3.14")
-                           (source
-                            (dummy-origin
-                             (patches
-                              (list "/a/b/pi-CVE-2015-1234.patch"))))))))))
-
-(test-assert "cve: known safe from vulnerability"
+        (append-warnings
+         (check-vulnerabilities
+          (dummy-package "pi"
+                         (version "3.14")
+                         (source
+                          (dummy-origin
+                           (patches
+                            (list "/a/b/pi-CVE-2015-1234.patch")))))))))
+
+(test-equal "cve: known safe from vulnerability"
+  '()
   (mock ((guix scripts lint) package-vulnerabilities
          (lambda (package)
            (list (make-struct (@@ (guix cve) <vulnerability>) 0
                               "CVE-2015-1234"
                               (list (cons (package-name package)
                                           (package-version package)))))))
-        (string-null?
-         (with-warnings
-           (check-vulnerabilities
-            (dummy-package "pi"
-                           (version "3.14")
-                           (properties `((lint-hidden-cve . ("CVE-2015-1234"))))))))))
-
-(test-assert "cve: vulnerability fixed in replacement version"
+        (append-warnings
+         (check-vulnerabilities
+          (dummy-package "pi"
+                         (version "3.14")
+                         (properties `((lint-hidden-cve . ("CVE-2015-1234")))))))))
+
+(test-equal "cve: vulnerability fixed in replacement version"
+  '()
   (mock ((guix scripts lint) package-vulnerabilities
          (lambda (package)
            (match (package-version package)
@@ -845,71 +774,64 @@
                                              (package-version package))))))
              ("1"
               '()))))
-        (and (not (string-null?
-                   (with-warnings
-                     (check-vulnerabilities
-                      (dummy-package "foo" (version "0"))))))
-             (string-null?
-              (with-warnings
-                (check-vulnerabilities
-                 (dummy-package
-                  "foo" (version "0")
-                  (replacement (dummy-package "foo" (version "1"))))))))))
-
-(test-assert "cve: patched vulnerability in replacement"
+        (append-warnings
+         (check-vulnerabilities
+          (dummy-package
+           "foo" (version "0")
+           (replacement (dummy-package "foo" (version "1"))))))))
+
+(test-equal "cve: patched vulnerability in replacement"
+  '()
   (mock ((guix scripts lint) package-vulnerabilities
          (lambda (package)
            (list (make-struct (@@ (guix cve) <vulnerability>) 0
                               "CVE-2015-1234"
                               (list (cons (package-name package)
                                           (package-version package)))))))
-        (string-null?
-         (with-warnings
-           (check-vulnerabilities
-            (dummy-package
-             "pi" (version "3.14") (source (dummy-origin))
-             (replacement (dummy-package
-                           "pi" (version "3.14")
-                           (source
-                            (dummy-origin
-                             (patches
-                              (list "/a/b/pi-CVE-2015-1234.patch"))))))))))))
-
-(test-assert "formatting: lonely parentheses"
-  (string-contains
-   (with-warnings
-     (check-formatting
-      (
-       dummy-package "ugly as hell!"
-      )
-      ))
-   "lonely"))
+        (append-warnings
+         (check-vulnerabilities
+          (dummy-package
+           "pi" (version "3.14") (source (dummy-origin))
+           (replacement (dummy-package
+                         "pi" (version "3.14")
+                         (source
+                          (dummy-origin
+                           (patches
+                            (list "/a/b/pi-CVE-2015-1234.patch")))))))))))
+
+(test-equal "formatting: lonely parentheses"
+  "parentheses feel lonely, move to the previous or next line"
+  (match (check-formatting
+          (dummy-package "ugly as hell!"
+                         )
+          )
+    ((($ <lint-warning> package message location)) message)))
 
 (test-assert "formatting: tabulation"
-  (string-contains
-   (with-warnings
-     (check-formatting (dummy-package "leave the tab here:	")))
-   "tabulation"))
+  (string-match-or-error
+   "tabulation on line [0-9]+, column [0-9]+"
+   (match (check-formatting (dummy-package "leave the tab here:	"))
+     ((($ <lint-warning> package message location))
+      message))))
 
 (test-assert "formatting: trailing white space"
-  (string-contains
-   (with-warnings
-     ;; Leave the trailing white space on the next line!
-     (check-formatting (dummy-package "x")))            
-   "trailing white space"))
+  (string-match-or-error
+   "trailing white space .*"
+   ;; Leave the trailing white space on the next line!
+   (match (check-formatting (dummy-package "x"))            
+     ((($ <lint-warning> package message location))
+      message))))
 
 (test-assert "formatting: long line"
-  (string-contains
-   (with-warnings
-     (check-formatting
-      (dummy-package "x"                          ;here is a stupid comment just to make a long line
-                     )))
-   "too long"))
-
-(test-assert "formatting: alright"
-  (string-null?
-   (with-warnings
-     (check-formatting (dummy-package "x")))))
+  (string-match-or-error
+   "line [0-9]+ is way too long \\([0-9]+ characters\\)"
+   (match (check-formatting
+           (dummy-package "x"))                                     ;here is a stupid comment just to make a long line
+     ((($ <lint-warning> package message location)) message))))
+
+(test-equal "formatting: alright"
+  '()
+  (append-warnings (check-formatting (dummy-package "x"))))
 
 (test-end "lint")
 
-- 
2.21.0