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