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