[bug#35790] scripts: lint: Handle warnings with a record type.
diff mbox series

Message ID 20190518093206.22069-1-mail@cbaines.net
State New
Headers show
Series
  • [bug#35790] scripts: lint: Handle warnings with a record type.
Related show

Checks

Context Check Description
cbaines/applying patch success Successfully applied

Commit Message

Christopher Baines May 18, 2019, 9:32 a.m. UTC
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(-)

Comments

Ludovic Courtès May 21, 2019, 2:41 p.m. UTC | #1
Hello!

Christopher Baines <mail@cbaines.net> skribis:

> 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.

Yay!

> +            <lint-warning>

As a rule of thumb, it’s best to not export the record type descriptor
(RTD) because then anything could happen.  In this case, I think the
tests would be just as readable if we used ‘lint-warning-message’ &
co. instead of matching on the record.

WDYT?

> +(define* (make-warning package message
> +                       #:key field location)
> +  (make-lint-warning
> +   package
> +   message

In practice MESSAGE is already translated.  I think it would be more
flexible if it were not; ‘lint-warning-message’ would always return the
English message, and it’d be up to the user to call ‘gettext’ on it,
like we do for package descriptions.

To achieve this, you’d need a little trick so that ‘xgettext’ can still
extract the messages, like:


  (define-syntax-rule make-warning
    (syntax-rule (G_)
      ((_ package (G_ message) rest ...)
       (%make-warning package message rest ...))))

where ‘%make-warning’ is the procedure you define above.

Then you need an explicit call to ‘G_’ at the point where messages are
displayed.

Does that make sense?

> +(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))

I always feel that we should have procedures that operate on lists of
anything, like ‘append’, and thus ‘append-warnings’ looks like an
anti-pattern to me.

What about simply ensuring that every checker returns a list of
<lint-warning>s?  That way, we wouldn’t have to do such things, I think.

That’s all!

Thanks,
Ludo’.
Christopher Baines June 1, 2019, 7:09 p.m. UTC | #2
Ludovic Courtès <ludo@gnu.org> writes:

> Hello!
>
> Christopher Baines <mail@cbaines.net> skribis:
>
>> 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.
>
> Yay!
>
>> +            <lint-warning>
>
> As a rule of thumb, it’s best to not export the record type descriptor
> (RTD) because then anything could happen.  In this case, I think the
> tests would be just as readable if we used ‘lint-warning-message’ &
> co. instead of matching on the record.
>
> WDYT?

Interesting. I've now adjusted the tests accordingly and sent an updated
patch.

I've stuck with using match, as this gives much better error messages
than using car, or lint-warning-message without checking the thing your
working with is actually a list with a single warning. I've wrapped this
up as a single-lint-warning-message that many of the tests use.

>> +(define* (make-warning package message
>> +                       #:key field location)
>> +  (make-lint-warning
>> +   package
>> +   message
>
> In practice MESSAGE is already translated.  I think it would be more
> flexible if it were not; ‘lint-warning-message’ would always return the
> English message, and it’d be up to the user to call ‘gettext’ on it,
> like we do for package descriptions.
>
> To achieve this, you’d need a little trick so that ‘xgettext’ can still
> extract the messages, like:
>
>
>   (define-syntax-rule make-warning
>     (syntax-rule (G_)
>       ((_ package (G_ message) rest ...)
>        (%make-warning package message rest ...))))
>
> where ‘%make-warning’ is the procedure you define above.
>
> Then you need an explicit call to ‘G_’ at the point where messages are
> displayed.
>
> Does that make sense?

Yes, but I'm unsure it'll work for all the messages.

Some of them it translates a format string first, then uses that format
string, and that becomes the message, e.g.

  (format #f (G_ "invalid description: ~s") description)

Given that you'd be trying to get the translation for "invalid
description: guile" for example, I'm not sure you can defer the
translation without also defering customising the message, if that makes
sense?

I haven't actually tried this yet, so I could be wrong.

>> +(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))
>
> I always feel that we should have procedures that operate on lists of
> anything, like ‘append’, and thus ‘append-warnings’ looks like an
> anti-pattern to me.
>
> What about simply ensuring that every checker returns a list of
> <lint-warning>s?  That way, we wouldn’t have to do such things, I think.

I did consider that initially, but it involved restructuring the code
even more, so I put it off. In this latest patch though, I have adjusted
it so all the checkers return lists of warnings.

Thanks for taking a look :)

Chris
Ludovic Courtès June 7, 2019, 7:38 a.m. UTC | #3
Hello,

Christopher Baines <mail@cbaines.net> skribis:

> Ludovic Courtès <ludo@gnu.org> writes:

[...]

>>> +(define* (make-warning package message
>>> +                       #:key field location)
>>> +  (make-lint-warning
>>> +   package
>>> +   message
>>
>> In practice MESSAGE is already translated.  I think it would be more
>> flexible if it were not; ‘lint-warning-message’ would always return the
>> English message, and it’d be up to the user to call ‘gettext’ on it,
>> like we do for package descriptions.
>>
>> To achieve this, you’d need a little trick so that ‘xgettext’ can still
>> extract the messages, like:
>>
>>
>>   (define-syntax-rule make-warning
>>     (syntax-rule (G_)
>>       ((_ package (G_ message) rest ...)
>>        (%make-warning package message rest ...))))
>>
>> where ‘%make-warning’ is the procedure you define above.
>>
>> Then you need an explicit call to ‘G_’ at the point where messages are
>> displayed.
>>
>> Does that make sense?
>
> Yes, but I'm unsure it'll work for all the messages.
>
> Some of them it translates a format string first, then uses that format
> string, and that becomes the message, e.g.
>
>   (format #f (G_ "invalid description: ~s") description)
>
> Given that you'd be trying to get the translation for "invalid
> description: guile" for example, I'm not sure you can defer the
> translation without also defering customising the message, if that makes
> sense?

Good point!

A possibility would be to pass ‘make-warning’ a ‘format’ list instead of
a single string:

  (make-warning package (list (G_ "~a is bad") 'something) …)

That’d solve the problem but it’d have to be packaged nicely to avoid
having too much boilerplate.

WDYT?

Thanks,
Ludo’.
Christopher Baines June 16, 2019, 1:05 p.m. UTC | #4
Ludovic Courtès <ludo@gnu.org> writes:

> A possibility would be to pass ‘make-warning’ a ‘format’ list instead of
> a single string:
>
>   (make-warning package (list (G_ "~a is bad") 'something) …)
>
> That’d solve the problem but it’d have to be packaged nicely to avoid
> having too much boilerplate.

I've now made an attempt at doing this, I've kept the changes separate
for now, and I've sent them as a separate patch.

I'm not sure I've got it working yet though. I've been testing with the
zile package, as there's a lint warning for the synopsis, however, if I
try to set the language to Spanish, it isn't translated.

I've also tried checking the existing behaviour, but that doesn't seem
to work either:

  → LC_MESSAGES=es_ES LANGUAGE=es_ES LC_ALL=es_ES ./pre-inst-env guile
  ...
  scheme@(guile-user)> (use-modules (guix i18n))
  scheme@(guile-user)> (G_ "~a: ~a: proposed synopsis: ~s~%")
  $1 = "~a: ~a: proposed synopsis: ~s~%"

Many of the translated strings won't match up with the code now as I've
changed them. I did try changing the Spanish translation for this
proposed synopsis message to match the code, but it didn't seem to work.

Any ideas on what's going on here?

Chris
Ludovic Courtès June 20, 2019, 11:49 a.m. UTC | #5
Christopher Baines <mail@cbaines.net> skribis:

> Ludovic Courtès <ludo@gnu.org> writes:
>
>> A possibility would be to pass ‘make-warning’ a ‘format’ list instead of
>> a single string:
>>
>>   (make-warning package (list (G_ "~a is bad") 'something) …)
>>
>> That’d solve the problem but it’d have to be packaged nicely to avoid
>> having too much boilerplate.
>
> I've now made an attempt at doing this, I've kept the changes separate
> for now, and I've sent them as a separate patch.

Nice!

> I'm not sure I've got it working yet though. I've been testing with the
> zile package, as there's a lint warning for the synopsis, however, if I
> try to set the language to Spanish, it isn't translated.
>
> I've also tried checking the existing behaviour, but that doesn't seem
> to work either:
>
>   → LC_MESSAGES=es_ES LANGUAGE=es_ES LC_ALL=es_ES ./pre-inst-env guile
>   ...
>   scheme@(guile-user)> (use-modules (guix i18n))
>   scheme@(guile-user)> (G_ "~a: ~a: proposed synopsis: ~s~%")
>   $1 = "~a: ~a: proposed synopsis: ~s~%"
>
> Many of the translated strings won't match up with the code now as I've
> changed them. I did try changing the Spanish translation for this
> proposed synopsis message to match the code, but it didn't seem to work.
>
> Any ideas on what's going on here?

You need to tell libc (gettext) where to look for message catalogs.
This is normally done in scripts/guix:

  (bindtextdomain "guix" "@localedir@")

For testing purposes, you can probably do:

  (bindtextdomain "guix"
                  "/run/current-system/profile/share/locale")

HTH!

Ludo’.
Christopher Baines June 24, 2019, 6:46 a.m. UTC | #6
Ludovic Courtès <ludo@gnu.org> writes:

> Christopher Baines <mail@cbaines.net> skribis:
>
>> Ludovic Courtès <ludo@gnu.org> writes:
>>
>>> A possibility would be to pass ‘make-warning’ a ‘format’ list instead of
>>> a single string:
>>>
>>>   (make-warning package (list (G_ "~a is bad") 'something) …)
>>>
>>> That’d solve the problem but it’d have to be packaged nicely to avoid
>>> having too much boilerplate.
>>
>> I've now made an attempt at doing this, I've kept the changes separate
>> for now, and I've sent them as a separate patch.
>
> Nice!
>
>> I'm not sure I've got it working yet though. I've been testing with the
>> zile package, as there's a lint warning for the synopsis, however, if I
>> try to set the language to Spanish, it isn't translated.
>>
>> I've also tried checking the existing behaviour, but that doesn't seem
>> to work either:
>>
>>   → LC_MESSAGES=es_ES LANGUAGE=es_ES LC_ALL=es_ES ./pre-inst-env guile
>>   ...
>>   scheme@(guile-user)> (use-modules (guix i18n))
>>   scheme@(guile-user)> (G_ "~a: ~a: proposed synopsis: ~s~%")
>>   $1 = "~a: ~a: proposed synopsis: ~s~%"
>>
>> Many of the translated strings won't match up with the code now as I've
>> changed them. I did try changing the Spanish translation for this
>> proposed synopsis message to match the code, but it didn't seem to work.
>>
>> Any ideas on what's going on here?
>
> You need to tell libc (gettext) where to look for message catalogs.
> This is normally done in scripts/guix:
>
>   (bindtextdomain "guix" "@localedir@")
>
> For testing purposes, you can probably do:
>
>   (bindtextdomain "guix"
>                   "/run/current-system/profile/share/locale")

Thanks, so if I set the bindtextdomain, things do indeed work
better. So, regarding these two patches, I've got the following things
on my mind...

 - As they change so many things, I'm not sure what to add for the GNU
   changelog at the end of the commit message?

 - Is it OK to break some of the translations, or should I fix some of
   those as well?

   - I'm thinking of the "proposed synopsis" related check specifically,
     as I've changed what goes in to the translated string.

 - How ready are these patches to merge? I don't know of any problems
   with them, but I am making lots of changes.

Thanks,

Chris
Ludovic Courtès June 24, 2019, 8:33 a.m. UTC | #7
Hi!  :-)

Christopher Baines <mail@cbaines.net> skribis:

>  - Is it OK to break some of the translations, or should I fix some of
>    those as well?
>
>    - I'm thinking of the "proposed synopsis" related check specifically,
>      as I've changed what goes in to the translated string.

It’s OK to change strings sometimes, but this has to be done
thoughtfully as it entails more translation work and a time window
during which translations aren’t up-to-date and everyone sees the
English string.

Let me look at the other issues…

Ludo’.
Ludovic Courtès June 24, 2019, 8:39 a.m. UTC | #8
Hi Chris,

Christopher Baines <mail@cbaines.net> skribis:

> Thanks, so if I set the bindtextdomain, things do indeed work
> better. So, regarding these two patches, I've got the following things
> on my mind...
>
>  - As they change so many things, I'm not sure what to add for the GNU
>    changelog at the end of the commit message?

I think you should try to write the commit log the usual way, by
listing every changed entity.  It’s a bit tedious, but it’s also a good
way to review everything (and Magit makes it relatively easy.)

Now, don’t lose your hair on it, it’s not the most important part of the
patch.  :-)

>  - Is it OK to break some of the translations, or should I fix some of
>    those as well?
>
>    - I'm thinking of the "proposed synopsis" related check specifically,
>      as I've changed what goes in to the translated string.

Actually I didn’t see the change you’re referring to, but maybe it
doesn’t matter much.

>  - How ready are these patches to merge? I don't know of any problems
>    with them, but I am making lots of changes.

I think it’s ready.

Thanks, and sorry for the delays!

Ludo’.
Christopher Baines June 29, 2019, 11:56 a.m. UTC | #9
Ludovic Courtès <ludo@gnu.org> writes:

> Hi Chris,
>
> Christopher Baines <mail@cbaines.net> skribis:
>
>> Thanks, so if I set the bindtextdomain, things do indeed work
>> better. So, regarding these two patches, I've got the following things
>> on my mind...
>>
>>  - As they change so many things, I'm not sure what to add for the GNU
>>    changelog at the end of the commit message?
>
> I think you should try to write the commit log the usual way, by
> listing every changed entity.  It’s a bit tedious, but it’s also a good
> way to review everything (and Magit makes it relatively easy.)

Ok, I've now made an initial attempt at this, and sent some updated
patches.
Ludovic Courtès July 1, 2019, 12:32 p.m. UTC | #10
Hi!

Christopher Baines <mail@cbaines.net> skribis:

> Ludovic Courtès <ludo@gnu.org> writes:
>
>> Hi Chris,
>>
>> Christopher Baines <mail@cbaines.net> skribis:
>>
>>> Thanks, so if I set the bindtextdomain, things do indeed work
>>> better. So, regarding these two patches, I've got the following things
>>> on my mind...
>>>
>>>  - As they change so many things, I'm not sure what to add for the GNU
>>>    changelog at the end of the commit message?
>>
>> I think you should try to write the commit log the usual way, by
>> listing every changed entity.  It’s a bit tedious, but it’s also a good
>> way to review everything (and Magit makes it relatively easy.)
>
> Ok, I've now made an initial attempt at this, and sent some updated
> patches.

Perfect, thanks for taking the time to do it.

Time to push!  :-)

Thanks,
Ludo’.
Christopher Baines July 2, 2019, 8:15 p.m. UTC | #11
Ludovic Courtès <ludo@gnu.org> writes:

> Hi!
>
> Christopher Baines <mail@cbaines.net> skribis:
>
>> Ludovic Courtès <ludo@gnu.org> writes:
>>
>>> Hi Chris,
>>>
>>> Christopher Baines <mail@cbaines.net> skribis:
>>>
>>>> Thanks, so if I set the bindtextdomain, things do indeed work
>>>> better. So, regarding these two patches, I've got the following things
>>>> on my mind...
>>>>
>>>>  - As they change so many things, I'm not sure what to add for the GNU
>>>>    changelog at the end of the commit message?
>>>
>>> I think you should try to write the commit log the usual way, by
>>> listing every changed entity.  It’s a bit tedious, but it’s also a good
>>> way to review everything (and Magit makes it relatively easy.)
>>
>> Ok, I've now made an initial attempt at this, and sent some updated
>> patches.
>
> Perfect, thanks for taking the time to do it.

Great :)

> Time to push!  :-)

Well... I'm happy to push these patches to master, but I've got some
more related changes in mind. It might be good to merge these all
together, to avoid churning up the codebase more than necessary.

I've sent another couple of patches, the first to move most of the
functionality from (guix scripts lint) to a new (guix lint) module.

The second patch then splits the checkers in to two groups, based on
whether they attempt to access the network.

This is still moving towards being able to easily lint all the packages
and store this information in the Guix Data Serivce.

Patch
diff mbox series

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")