tests/lint.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
   3 ;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org>
   4 ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
   5 ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
   6 ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
   7 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
   8 ;;;
   9 ;;; This file is part of GNU Guix.
  10 ;;;
  11 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  12 ;;; under the terms of the GNU General Public License as published by
  13 ;;; the Free Software Foundation; either version 3 of the License, or (at
  14 ;;; your option) any later version.
  15 ;;;
  16 ;;; GNU Guix is distributed in the hope that it will be useful, but
  17 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;;; GNU General Public License for more details.
  20 ;;;
  21 ;;; You should have received a copy of the GNU General Public License
  22 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;; Avoid interference.
  25 (unsetenv "http_proxy")
  26
  27 (define-module (test-lint)
  28   #:use-module (guix tests)
  29   #:use-module (guix tests http)
  30   #:use-module (guix download)
  31   #:use-module (guix git-download)
  32   #:use-module (guix build-system gnu)
  33   #:use-module (guix packages)
  34   #:use-module (guix scripts lint)
  35   #:use-module (guix ui)
  36   #:use-module (gnu packages)
  37   #:use-module (gnu packages glib)
  38   #:use-module (gnu packages pkg-config)
  39   #:use-module (gnu packages python)
  40   #:use-module (web uri)
  41   #:use-module (web server)
  42   #:use-module (web server http)
  43   #:use-module (web response)
  44   #:use-module (ice-9 match)
  45   #:use-module (srfi srfi-9 gnu)
  46   #:use-module (srfi srfi-64))
  47
  48 ;; Test the linter.
  49
  50 ;; Avoid collisions with other tests.
  51 (%http-server-port 9999)
  52
  53 (define %null-sha256
  54   ;; SHA256 of the empty string.
  55   (base32
  56    "0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73"))
  57
  58 (define %long-string
  59   (make-string 2000 #\a))
  60
  61 \f
  62 (test-begin "lint")
  63
  64 (define (call-with-warnings thunk)
  65   (let ((port (open-output-string)))
  66     (parameterize ((guix-warning-port port))
  67       (thunk))
  68     (get-output-string port)))
  69
  70 (define-syntax-rule (with-warnings body ...)
  71   (call-with-warnings (lambda () body ...)))
  72
  73 (test-assert "description: not a string"
  74   (->bool
  75    (string-contains (with-warnings
  76                       (let ((pkg (dummy-package "x"
  77                                    (description 'foobar))))
  78                         (check-description-style pkg)))
  79                     "invalid description")))
  80
  81 (test-assert "description: not empty"
  82   (->bool
  83    (string-contains (with-warnings
  84                       (let ((pkg (dummy-package "x"
  85                                    (description ""))))
  86                         (check-description-style pkg)))
  87                     "description should not be empty")))
  88
  89 (test-assert "description: valid Texinfo markup"
  90   (->bool
  91    (string-contains
  92     (with-warnings
  93       (check-description-style (dummy-package "x" (description "f{oo}b@r"))))
  94     "Texinfo markup in description is invalid")))
  95
  96 (test-assert "description: does not start with an upper-case letter"
  97   (->bool
  98    (string-contains (with-warnings
  99                       (let ((pkg (dummy-package "x"
 100                                    (description "bad description."))))
 101                         (check-description-style pkg)))
 102                     "description should start with an upper-case letter")))
 103
 104 (test-assert "description: may start with a digit"
 105   (string-null?
 106    (with-warnings
 107      (let ((pkg (dummy-package "x"
 108                   (description "2-component library."))))
 109        (check-description-style pkg)))))
 110
 111 (test-assert "description: may start with lower-case package name"
 112   (string-null?
 113    (with-warnings
 114      (let ((pkg (dummy-package "x"
 115                   (description "x is a dummy package."))))
 116        (check-description-style pkg)))))
 117
 118 (test-assert "description: two spaces after end of sentence"
 119   (->bool
 120    (string-contains (with-warnings
 121                       (let ((pkg (dummy-package "x"
 122                                    (description "Bad. Quite bad."))))
 123                         (check-description-style pkg)))
 124                     "sentences in description should be followed by two spaces")))
 125
 126 (test-assert "description: end-of-sentence detection with abbreviations"
 127   (string-null?
 128    (with-warnings
 129      (let ((pkg (dummy-package "x"
 130                   (description
 131                    "E.g. Foo, i.e. Bar resp. Baz (a.k.a. DVD)."))))
 132        (check-description-style pkg)))))
 133
 134 (test-assert "description: may not contain trademark signs"
 135   (and (->bool
 136         (string-contains (with-warnings
 137                            (let ((pkg (dummy-package "x"
 138                                         (description "Does The Right Thing™"))))
 139                              (check-description-style pkg)))
 140                          "should not contain trademark sign"))
 141        (->bool
 142         (string-contains (with-warnings
 143                            (let ((pkg (dummy-package "x"
 144                                         (description "Works with Format®"))))
 145                              (check-description-style pkg)))
 146                          "should not contain trademark sign"))))
 147
 148 (test-assert "description: suggest ornament instead of quotes"
 149   (->bool
 150    (string-contains (with-warnings
 151                       (let ((pkg (dummy-package "x"
 152                                    (description "This is a 'quoted' thing."))))
 153                         (check-description-style pkg)))
 154                     "use @code")))
 155
 156 (test-assert "synopsis: not a string"
 157   (->bool
 158    (string-contains (with-warnings
 159                       (let ((pkg (dummy-package "x"
 160                                    (synopsis #f))))
 161                         (check-synopsis-style pkg)))
 162                     "invalid synopsis")))
 163
 164 (test-assert "synopsis: not empty"
 165   (->bool
 166    (string-contains (with-warnings
 167                       (let ((pkg (dummy-package "x"
 168                                    (synopsis ""))))
 169                         (check-synopsis-style pkg)))
 170                     "synopsis should not be empty")))
 171
 172 (test-assert "synopsis: valid Texinfo markup"
 173   (->bool
 174    (string-contains
 175     (with-warnings
 176       (check-synopsis-style (dummy-package "x" (synopsis "Bad $@ texinfo"))))
 177     "Texinfo markup in synopsis is invalid")))
 178
 179 (test-assert "synopsis: does not start with an upper-case letter"
 180   (->bool
 181    (string-contains (with-warnings
 182                       (let ((pkg (dummy-package "x"
 183                                    (synopsis "bad synopsis."))))
 184                         (check-synopsis-style pkg)))
 185                     "synopsis should start with an upper-case letter")))
 186
 187 (test-assert "synopsis: may start with a digit"
 188   (string-null?
 189    (with-warnings
 190      (let ((pkg (dummy-package "x"
 191                   (synopsis "5-dimensional frobnicator"))))
 192        (check-synopsis-style pkg)))))
 193
 194 (test-assert "synopsis: ends with a period"
 195   (->bool
 196    (string-contains (with-warnings
 197                       (let ((pkg (dummy-package "x"
 198                                    (synopsis "Bad synopsis."))))
 199                         (check-synopsis-style pkg)))
 200                     "no period allowed at the end of the synopsis")))
 201
 202 (test-assert "synopsis: ends with 'etc.'"
 203   (string-null? (with-warnings
 204                   (let ((pkg (dummy-package "x"
 205                                (synopsis "Foo, bar, etc."))))
 206                     (check-synopsis-style pkg)))))
 207
 208 (test-assert "synopsis: starts with 'A'"
 209   (->bool
 210    (string-contains (with-warnings
 211                       (let ((pkg (dummy-package "x"
 212                                    (synopsis "A bad synopŝis"))))
 213                         (check-synopsis-style pkg)))
 214                     "no article allowed at the beginning of the synopsis")))
 215
 216 (test-assert "synopsis: starts with 'An'"
 217   (->bool
 218    (string-contains (with-warnings
 219                       (let ((pkg (dummy-package "x"
 220                                    (synopsis "An awful synopsis"))))
 221                         (check-synopsis-style pkg)))
 222                     "no article allowed at the beginning of the synopsis")))
 223
 224 (test-assert "synopsis: starts with 'a'"
 225   (->bool
 226    (string-contains (with-warnings
 227                       (let ((pkg (dummy-package "x"
 228                                    (synopsis "a bad synopsis"))))
 229                         (check-synopsis-style pkg)))
 230                     "no article allowed at the beginning of the synopsis")))
 231
 232 (test-assert "synopsis: starts with 'an'"
 233   (->bool
 234    (string-contains (with-warnings
 235                       (let ((pkg (dummy-package "x"
 236                                    (synopsis "an awful synopsis"))))
 237                         (check-synopsis-style pkg)))
 238                     "no article allowed at the beginning of the synopsis")))
 239
 240 (test-assert "synopsis: too long"
 241   (->bool
 242    (string-contains (with-warnings
 243                       (let ((pkg (dummy-package "x"
 244                                    (synopsis (make-string 80 #\x)))))
 245                         (check-synopsis-style pkg)))
 246                     "synopsis should be less than 80 characters long")))
 247
 248 (test-assert "synopsis: start with package name"
 249   (->bool
 250    (string-contains (with-warnings
 251                       (let ((pkg (dummy-package "x"
 252                                    (name "foo")
 253                                    (synopsis "foo, a nice package"))))
 254                         (check-synopsis-style pkg)))
 255                     "synopsis should not start with the package name")))
 256
 257 (test-assert "synopsis: start with package name prefix"
 258   (string-null?
 259    (with-warnings
 260      (let ((pkg (dummy-package "arb"
 261                   (synopsis "Arbitrary precision"))))
 262        (check-synopsis-style pkg)))))
 263
 264 (test-assert "synopsis: start with abbreviation"
 265   (string-null?
 266    (with-warnings
 267      (let ((pkg (dummy-package "uucp"
 268                   ;; Same problem with "APL interpreter", etc.
 269                   (synopsis "UUCP implementation")
 270                   (description "Imagine this is Taylor UUCP."))))
 271        (check-synopsis-style pkg)))))
 272
 273 (test-assert "inputs: pkg-config is probably a native input"
 274   (->bool
 275    (string-contains
 276      (with-warnings
 277        (let ((pkg (dummy-package "x"
 278                     (inputs `(("pkg-config" ,pkg-config))))))
 279          (check-inputs-should-be-native pkg)))
 280          "'pkg-config' should probably be a native input")))
 281
 282 (test-assert "inputs: glib:bin is probably a native input"
 283   (->bool
 284     (string-contains
 285       (with-warnings
 286         (let ((pkg (dummy-package "x"
 287                      (inputs `(("glib" ,glib "bin"))))))
 288           (check-inputs-should-be-native pkg)))
 289           "'glib:bin' should probably be a native input")))
 290
 291 (test-assert
 292     "inputs: python-setuptools should not be an input at all (input)"
 293   (->bool
 294    (string-contains
 295      (with-warnings
 296        (let ((pkg (dummy-package "x"
 297                     (inputs `(("python-setuptools" ,python-setuptools))))))
 298          (check-inputs-should-not-be-an-input-at-all pkg)))
 299          "'python-setuptools' should probably not be an input at all")))
 300
 301 (test-assert
 302     "inputs: python-setuptools should not be an input at all (native-input)"
 303   (->bool
 304    (string-contains
 305      (with-warnings
 306        (let ((pkg (dummy-package "x"
 307                     (native-inputs
 308                      `(("python-setuptools" ,python-setuptools))))))
 309          (check-inputs-should-not-be-an-input-at-all pkg)))
 310          "'python-setuptools' should probably not be an input at all")))
 311
 312 (test-assert
 313     "inputs: python-setuptools should not be an input at all (propagated-input)"
 314   (->bool
 315    (string-contains
 316      (with-warnings
 317        (let ((pkg (dummy-package "x"
 318                     (propagated-inputs
 319                      `(("python-setuptools" ,python-setuptools))))))
 320          (check-inputs-should-not-be-an-input-at-all pkg)))
 321          "'python-setuptools' should probably not be an input at all")))
 322
 323 (test-assert "patches: file names"
 324   (->bool
 325    (string-contains
 326      (with-warnings
 327        (let ((pkg (dummy-package "x"
 328                     (source
 329                      (dummy-origin
 330                        (patches (list "/path/to/y.patch")))))))
 331          (check-patch-file-names pkg)))
 332      "file names of patches should start with the package name")))
 333
 334 (test-assert "patches: not found"
 335   (->bool
 336    (string-contains
 337      (with-warnings
 338        (let ((pkg (dummy-package "x"
 339                     (source
 340                      (dummy-origin
 341                        (patches
 342                         (list (search-patch "this-patch-does-not-exist!"))))))))
 343          (check-patch-file-names pkg)))
 344      "patch not found")))
 345
 346 (test-assert "derivation: invalid arguments"
 347   (->bool
 348    (string-contains
 349     (with-warnings
 350       (let ((pkg (dummy-package "x"
 351                    (arguments
 352                     '(#:imported-modules (invalid-module))))))
 353         (check-derivation pkg)))
 354     "failed to create derivation")))
 355
 356 (test-assert "license: invalid license"
 357   (string-contains
 358    (with-warnings
 359      (check-license (dummy-package "x" (license #f))))
 360    "invalid license"))
 361
 362 (test-assert "home-page: wrong home-page"
 363   (->bool
 364    (string-contains
 365     (with-warnings
 366       (let ((pkg (package
 367                    (inherit (dummy-package "x"))
 368                    (home-page #f))))
 369         (check-home-page pkg)))
 370     "invalid")))
 371
 372 (test-assert "home-page: invalid URI"
 373   (->bool
 374    (string-contains
 375     (with-warnings
 376       (let ((pkg (package
 377                    (inherit (dummy-package "x"))
 378                    (home-page "foobar"))))
 379         (check-home-page pkg)))
 380     "invalid home page URL")))
 381
 382 (test-assert "home-page: host not found"
 383   (->bool
 384    (string-contains
 385     (with-warnings
 386       (let ((pkg (package
 387                    (inherit (dummy-package "x"))
 388                    (home-page "http://does-not-exist"))))
 389         (check-home-page pkg)))
 390     "domain not found")))
 391
 392 (test-skip (if (http-server-can-listen?) 0 1))
 393 (test-assert "home-page: Connection refused"
 394   (->bool
 395    (string-contains
 396     (with-warnings
 397       (let ((pkg (package
 398                    (inherit (dummy-package "x"))
 399                    (home-page (%local-url)))))
 400         (check-home-page pkg)))
 401     "Connection refused")))
 402
 403 (test-skip (if (http-server-can-listen?) 0 1))
 404 (test-equal "home-page: 200"
 405   ""
 406   (with-warnings
 407    (with-http-server 200 %long-string
 408      (let ((pkg (package
 409                   (inherit (dummy-package "x"))
 410                   (home-page (%local-url)))))
 411        (check-home-page pkg)))))
 412
 413 (test-skip (if (http-server-can-listen?) 0 1))
 414 (test-assert "home-page: 200 but short length"
 415   (->bool
 416    (string-contains
 417     (with-warnings
 418       (with-http-server 200 "This is too small."
 419         (let ((pkg (package
 420                      (inherit (dummy-package "x"))
 421                      (home-page (%local-url)))))
 422           (check-home-page pkg))))
 423     "suspiciously small")))
 424
 425 (test-skip (if (http-server-can-listen?) 0 1))
 426 (test-assert "home-page: 404"
 427   (->bool
 428    (string-contains
 429     (with-warnings
 430       (with-http-server 404 %long-string
 431         (let ((pkg (package
 432                      (inherit (dummy-package "x"))
 433                      (home-page (%local-url)))))
 434           (check-home-page pkg))))
 435     "not reachable: 404")))
 436
 437 (test-skip (if (http-server-can-listen?) 0 1))
 438 (test-assert "home-page: 301, invalid"
 439   (->bool
 440    (string-contains
 441     (with-warnings
 442       (with-http-server 301 %long-string
 443         (let ((pkg (package
 444                      (inherit (dummy-package "x"))
 445                      (home-page (%local-url)))))
 446           (check-home-page pkg))))
 447     "invalid permanent redirect")))
 448
 449 (test-skip (if (http-server-can-listen?) 0 1))
 450 (test-assert "home-page: 301 -> 200"
 451   (->bool
 452    (string-contains
 453     (with-warnings
 454       (with-http-server 200 %long-string
 455         (let ((initial-url (%local-url)))
 456           (parameterize ((%http-server-port (+ 1 (%http-server-port))))
 457             (with-http-server (301 `((location
 458                                       . ,(string->uri initial-url))))
 459                 ""
 460               (let ((pkg (package
 461                            (inherit (dummy-package "x"))
 462                            (home-page (%local-url)))))
 463                 (check-home-page pkg)))))))
 464     "permanent redirect")))
 465
 466 (test-skip (if (http-server-can-listen?) 0 1))
 467 (test-assert "home-page: 301 -> 404"
 468   (->bool
 469    (string-contains
 470     (with-warnings
 471       (with-http-server 404 "booh!"
 472         (let ((initial-url (%local-url)))
 473           (parameterize ((%http-server-port (+ 1 (%http-server-port))))
 474             (with-http-server (301 `((location
 475                                       . ,(string->uri initial-url))))
 476                 ""
 477               (let ((pkg (package
 478                            (inherit (dummy-package "x"))
 479                            (home-page (%local-url)))))
 480                 (check-home-page pkg)))))))
 481     "not reachable: 404")))
 482
 483 (test-assert "source-file-name"
 484   (->bool
 485    (string-contains
 486     (with-warnings
 487       (let ((pkg (dummy-package "x"
 488                    (version "3.2.1")
 489                    (source
 490                     (origin
 491                       (method url-fetch)
 492                       (uri "http://www.example.com/3.2.1.tar.gz")
 493                       (sha256 %null-sha256))))))
 494         (check-source-file-name pkg)))
 495     "file name should contain the package name")))
 496
 497 (test-assert "source-file-name: v prefix"
 498   (->bool
 499    (string-contains
 500     (with-warnings
 501       (let ((pkg (dummy-package "x"
 502                    (version "3.2.1")
 503                    (source
 504                     (origin
 505                       (method url-fetch)
 506                       (uri "http://www.example.com/v3.2.1.tar.gz")
 507                       (sha256 %null-sha256))))))
 508         (check-source-file-name pkg)))
 509     "file name should contain the package name")))
 510
 511 (test-assert "source-file-name: bad checkout"
 512   (->bool
 513    (string-contains
 514     (with-warnings
 515       (let ((pkg (dummy-package "x"
 516                    (version "3.2.1")
 517                    (source
 518                     (origin
 519                       (method git-fetch)
 520                       (uri (git-reference
 521                             (url "http://www.example.com/x.git")
 522                             (commit "0")))
 523                       (sha256 %null-sha256))))))
 524         (check-source-file-name pkg)))
 525     "file name should contain the package name")))
 526
 527 (test-assert "source-file-name: good checkout"
 528   (not
 529    (->bool
 530     (string-contains
 531      (with-warnings
 532        (let ((pkg (dummy-package "x"
 533                     (version "3.2.1")
 534                     (source
 535                      (origin
 536                        (method git-fetch)
 537                        (uri (git-reference
 538                              (url "http://git.example.com/x.git")
 539                              (commit "0")))
 540                        (file-name (string-append "x-" version))
 541                        (sha256 %null-sha256))))))
 542          (check-source-file-name pkg)))
 543      "file name should contain the package name"))))
 544
 545 (test-assert "source-file-name: valid"
 546   (not
 547    (->bool
 548     (string-contains
 549      (with-warnings
 550        (let ((pkg (dummy-package "x"
 551                     (version "3.2.1")
 552                     (source
 553                      (origin
 554                        (method url-fetch)
 555                        (uri "http://www.example.com/x-3.2.1.tar.gz")
 556                        (sha256 %null-sha256))))))
 557          (check-source-file-name pkg)))
 558      "file name should contain the package name"))))
 559
 560 (test-skip (if (http-server-can-listen?) 0 1))
 561 (test-equal "source: 200"
 562   ""
 563   (with-warnings
 564    (with-http-server 200 %long-string
 565      (let ((pkg (package
 566                   (inherit (dummy-package "x"))
 567                   (source (origin
 568                             (method url-fetch)
 569                             (uri (%local-url))
 570                             (sha256 %null-sha256))))))
 571        (check-source pkg)))))
 572
 573 (test-skip (if (http-server-can-listen?) 0 1))
 574 (test-assert "source: 200 but short length"
 575   (->bool
 576    (string-contains
 577     (with-warnings
 578       (with-http-server 200 "This is too small."
 579         (let ((pkg (package
 580                      (inherit (dummy-package "x"))
 581                      (source (origin
 582                                (method url-fetch)
 583                                (uri (%local-url))
 584                                (sha256 %null-sha256))))))
 585           (check-source pkg))))
 586     "suspiciously small")))
 587
 588 (test-skip (if (http-server-can-listen?) 0 1))
 589 (test-assert "source: 404"
 590   (->bool
 591    (string-contains
 592     (with-warnings
 593       (with-http-server 404 %long-string
 594         (let ((pkg (package
 595                      (inherit (dummy-package "x"))
 596                      (source (origin
 597                                (method url-fetch)
 598                                (uri (%local-url))
 599                                (sha256 %null-sha256))))))
 600           (check-source pkg))))
 601     "not reachable: 404")))
 602
 603 (test-skip (if (http-server-can-listen?) 0 1))
 604 (test-equal "source: 301 -> 200"
 605   ""
 606   (with-warnings
 607     (with-http-server 200 %long-string
 608       (let ((initial-url (%local-url)))
 609         (parameterize ((%http-server-port (+ 1 (%http-server-port))))
 610           (with-http-server (301 `((location . ,(string->uri initial-url))))
 611               ""
 612             (let ((pkg (package
 613                          (inherit (dummy-package "x"))
 614                          (source (origin
 615                                    (method url-fetch)
 616                                    (uri (%local-url))
 617                                    (sha256 %null-sha256))))))
 618               (check-source pkg))))))))
 619
 620 (test-skip (if (http-server-can-listen?) 0 1))
 621 (test-assert "source: 301 -> 404"
 622   (->bool
 623    (string-contains
 624     (with-warnings
 625       (with-http-server 404 "booh!"
 626         (let ((initial-url (%local-url)))
 627           (parameterize ((%http-server-port (+ 1 (%http-server-port))))
 628             (with-http-server (301 `((location . ,(string->uri initial-url))))
 629                 ""
 630               (let ((pkg (package
 631                            (inherit (dummy-package "x"))
 632                            (source (origin
 633                                      (method url-fetch)
 634                                      (uri (%local-url))
 635                                      (sha256 %null-sha256))))))
 636                 (check-source pkg)))))))
 637     "not reachable: 404")))
 638
 639 (test-assert "mirror-url"
 640   (string-null?
 641    (with-warnings
 642      (let ((source (origin
 643                      (method url-fetch)
 644                      (uri "http://example.org/foo/bar.tar.gz")
 645                      (sha256 %null-sha256))))
 646        (check-mirror-url (dummy-package "x" (source source)))))))
 647
 648 (test-assert "mirror-url: one suggestion"
 649   (string-contains
 650    (with-warnings
 651      (let ((source (origin
 652                      (method url-fetch)
 653                      (uri "http://ftp.gnu.org/pub/gnu/foo/foo.tar.gz")
 654                      (sha256 %null-sha256))))
 655        (check-mirror-url (dummy-package "x" (source source)))))
 656    "mirror://gnu/foo/foo.tar.gz"))
 657
 658 (test-assert "cve"
 659   (mock ((guix scripts lint) package-vulnerabilities (const '()))
 660         (string-null?
 661          (with-warnings (check-vulnerabilities (dummy-package "x"))))))
 662
 663 (test-assert "cve: one vulnerability"
 664   (mock ((guix scripts lint) package-vulnerabilities
 665          (lambda (package)
 666            (list (make-struct (@@ (guix cve) <vulnerability>) 0
 667                               "CVE-2015-1234"
 668                               (list (cons (package-name package)
 669                                           (package-version package)))))))
 670         (string-contains
 671          (with-warnings
 672            (check-vulnerabilities (dummy-package "pi" (version "3.14"))))
 673          "vulnerable to CVE-2015-1234")))
 674
 675 (test-assert "cve: one patched vulnerability"
 676   (mock ((guix scripts lint) package-vulnerabilities
 677          (lambda (package)
 678            (list (make-struct (@@ (guix cve) <vulnerability>) 0
 679                               "CVE-2015-1234"
 680                               (list (cons (package-name package)
 681                                           (package-version package)))))))
 682         (string-null?
 683          (with-warnings
 684            (check-vulnerabilities
 685             (dummy-package "pi"
 686                            (version "3.14")
 687                            (source
 688                             (dummy-origin
 689                              (patches
 690                               (list "/a/b/pi-CVE-2015-1234.patch"))))))))))
 691
 692 (test-assert "cve: vulnerability fixed in replacement version"
 693   (mock ((guix scripts lint) package-vulnerabilities
 694          (lambda (package)
 695            (match (package-version package)
 696              ("0"
 697               (list (make-struct (@@ (guix cve) <vulnerability>) 0
 698                                  "CVE-2015-1234"
 699                                  (list (cons (package-name package)
 700                                              (package-version package))))))
 701              ("1"
 702               '()))))
 703         (and (not (string-null?
 704                    (with-warnings
 705                      (check-vulnerabilities
 706                       (dummy-package "foo" (version "0"))))))
 707              (string-null?
 708               (with-warnings
 709                 (check-vulnerabilities
 710                  (dummy-package
 711                   "foo" (version "0")
 712                   (replacement (dummy-package "foo" (version "1"))))))))))
 713
 714 (test-assert "cve: patched vulnerability in replacement"
 715   (mock ((guix scripts lint) package-vulnerabilities
 716          (lambda (package)
 717            (list (make-struct (@@ (guix cve) <vulnerability>) 0
 718                               "CVE-2015-1234"
 719                               (list (cons (package-name package)
 720                                           (package-version package)))))))
 721         (string-null?
 722          (with-warnings
 723            (check-vulnerabilities
 724             (dummy-package
 725              "pi" (version "3.14") (source (dummy-origin))
 726              (replacement (dummy-package
 727                            "pi" (version "3.14")
 728                            (source
 729                             (dummy-origin
 730                              (patches
 731                               (list "/a/b/pi-CVE-2015-1234.patch"))))))))))))
 732
 733 (test-assert "formatting: lonely parentheses"
 734   (string-contains
 735    (with-warnings
 736      (check-formatting
 737       (
 738        dummy-package "ugly as hell!"
 739       )
 740       ))
 741    "lonely"))
 742
 743 (test-assert "formatting: tabulation"
 744   (string-contains
 745    (with-warnings
 746      (check-formatting (dummy-package "leave the tab here:      ")))
 747    "tabulation"))
 748
 749 (test-assert "formatting: trailing white space"
 750   (string-contains
 751    (with-warnings
 752      ;; Leave the trailing white space on the next line!
 753      (check-formatting (dummy-package "x")))
 754    "trailing white space"))
 755
 756 (test-assert "formatting: long line"
 757   (string-contains
 758    (with-warnings
 759      (check-formatting
 760       (dummy-package "x"                          ;here is a stupid comment just to make a long line
 761                      )))
 762    "too long"))
 763
 764 (test-assert "formatting: alright"
 765   (string-null?
 766    (with-warnings
 767      (check-formatting (dummy-package "x")))))
 768
 769 (test-end "lint")
 770
 771 ;; Local Variables:
 772 ;; eval: (put 'with-http-server 'scheme-indent-function 2)
 773 ;; eval: (put 'with-warnings 'scheme-indent-function 0)
 774 ;; End: