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>
9 ;;; This file is part of GNU Guix.
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.
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.
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/>.
24 ;; Avoid interference.
25 (unsetenv "http_proxy")
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))
50 ;; Avoid collisions with other tests.
51 (%http-server-port 9999)
54 ;; SHA256 of the empty string.
56 "0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73"))
59 (make-string 2000 #\a))
64 (define (call-with-warnings thunk)
65 (let ((port (open-output-string)))
66 (parameterize ((guix-warning-port port))
68 (get-output-string port)))
70 (define-syntax-rule (with-warnings body ...)
71 (call-with-warnings (lambda () body ...)))
73 (test-assert "description: not a string"
75 (string-contains (with-warnings
76 (let ((pkg (dummy-package "x"
77 (description 'foobar))))
78 (check-description-style pkg)))
79 "invalid description")))
81 (test-assert "description: not empty"
83 (string-contains (with-warnings
84 (let ((pkg (dummy-package "x"
86 (check-description-style pkg)))
87 "description should not be empty")))
89 (test-assert "description: valid Texinfo markup"
93 (check-description-style (dummy-package "x" (description "f{oo}b@r"))))
94 "Texinfo markup in description is invalid")))
96 (test-assert "description: does not start with an upper-case letter"
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")))
104 (test-assert "description: may start with a digit"
107 (let ((pkg (dummy-package "x"
108 (description "2-component library."))))
109 (check-description-style pkg)))))
111 (test-assert "description: may start with lower-case package name"
114 (let ((pkg (dummy-package "x"
115 (description "x is a dummy package."))))
116 (check-description-style pkg)))))
118 (test-assert "description: two spaces after end of sentence"
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")))
126 (test-assert "description: end-of-sentence detection with abbreviations"
129 (let ((pkg (dummy-package "x"
131 "E.g. Foo, i.e. Bar resp. Baz (a.k.a. DVD)."))))
132 (check-description-style pkg)))))
134 (test-assert "description: may not contain trademark signs"
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"))
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"))))
148 (test-assert "description: suggest ornament instead of quotes"
150 (string-contains (with-warnings
151 (let ((pkg (dummy-package "x"
152 (description "This is a 'quoted' thing."))))
153 (check-description-style pkg)))
156 (test-assert "synopsis: not a string"
158 (string-contains (with-warnings
159 (let ((pkg (dummy-package "x"
161 (check-synopsis-style pkg)))
162 "invalid synopsis")))
164 (test-assert "synopsis: not empty"
166 (string-contains (with-warnings
167 (let ((pkg (dummy-package "x"
169 (check-synopsis-style pkg)))
170 "synopsis should not be empty")))
172 (test-assert "synopsis: valid Texinfo markup"
176 (check-synopsis-style (dummy-package "x" (synopsis "Bad $@ texinfo"))))
177 "Texinfo markup in synopsis is invalid")))
179 (test-assert "synopsis: does not start with an upper-case letter"
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")))
187 (test-assert "synopsis: may start with a digit"
190 (let ((pkg (dummy-package "x"
191 (synopsis "5-dimensional frobnicator"))))
192 (check-synopsis-style pkg)))))
194 (test-assert "synopsis: ends with a period"
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")))
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)))))
208 (test-assert "synopsis: starts with 'A'"
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")))
216 (test-assert "synopsis: starts with 'An'"
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")))
224 (test-assert "synopsis: starts with 'a'"
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")))
232 (test-assert "synopsis: starts with 'an'"
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")))
240 (test-assert "synopsis: too long"
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")))
248 (test-assert "synopsis: start with package name"
250 (string-contains (with-warnings
251 (let ((pkg (dummy-package "x"
253 (synopsis "foo, a nice package"))))
254 (check-synopsis-style pkg)))
255 "synopsis should not start with the package name")))
257 (test-assert "synopsis: start with package name prefix"
260 (let ((pkg (dummy-package "arb"
261 (synopsis "Arbitrary precision"))))
262 (check-synopsis-style pkg)))))
264 (test-assert "synopsis: start with abbreviation"
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)))))
273 (test-assert "inputs: pkg-config is probably a native input"
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")))
282 (test-assert "inputs: glib:bin is probably a native input"
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")))
292 "inputs: python-setuptools should not be an input at all (input)"
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")))
302 "inputs: python-setuptools should not be an input at all (native-input)"
306 (let ((pkg (dummy-package "x"
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")))
313 "inputs: python-setuptools should not be an input at all (propagated-input)"
317 (let ((pkg (dummy-package "x"
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")))
323 (test-assert "patches: file names"
327 (let ((pkg (dummy-package "x"
330 (patches (list "/path/to/y.patch")))))))
331 (check-patch-file-names pkg)))
332 "file names of patches should start with the package name")))
334 (test-assert "patches: not found"
338 (let ((pkg (dummy-package "x"
342 (list (search-patch "this-patch-does-not-exist!"))))))))
343 (check-patch-file-names pkg)))
346 (test-assert "derivation: invalid arguments"
350 (let ((pkg (dummy-package "x"
352 '(#:imported-modules (invalid-module))))))
353 (check-derivation pkg)))
354 "failed to create derivation")))
356 (test-assert "license: invalid license"
359 (check-license (dummy-package "x" (license #f))))
362 (test-assert "home-page: wrong home-page"
367 (inherit (dummy-package "x"))
369 (check-home-page pkg)))
372 (test-assert "home-page: invalid URI"
377 (inherit (dummy-package "x"))
378 (home-page "foobar"))))
379 (check-home-page pkg)))
380 "invalid home page URL")))
382 (test-assert "home-page: host not found"
387 (inherit (dummy-package "x"))
388 (home-page "http://does-not-exist"))))
389 (check-home-page pkg)))
390 "domain not found")))
392 (test-skip (if (http-server-can-listen?) 0 1))
393 (test-assert "home-page: Connection refused"
398 (inherit (dummy-package "x"))
399 (home-page (%local-url)))))
400 (check-home-page pkg)))
401 "Connection refused")))
403 (test-skip (if (http-server-can-listen?) 0 1))
404 (test-equal "home-page: 200"
407 (with-http-server 200 %long-string
409 (inherit (dummy-package "x"))
410 (home-page (%local-url)))))
411 (check-home-page pkg)))))
413 (test-skip (if (http-server-can-listen?) 0 1))
414 (test-assert "home-page: 200 but short length"
418 (with-http-server 200 "This is too small."
420 (inherit (dummy-package "x"))
421 (home-page (%local-url)))))
422 (check-home-page pkg))))
423 "suspiciously small")))
425 (test-skip (if (http-server-can-listen?) 0 1))
426 (test-assert "home-page: 404"
430 (with-http-server 404 %long-string
432 (inherit (dummy-package "x"))
433 (home-page (%local-url)))))
434 (check-home-page pkg))))
435 "not reachable: 404")))
437 (test-skip (if (http-server-can-listen?) 0 1))
438 (test-assert "home-page: 301, invalid"
442 (with-http-server 301 %long-string
444 (inherit (dummy-package "x"))
445 (home-page (%local-url)))))
446 (check-home-page pkg))))
447 "invalid permanent redirect")))
449 (test-skip (if (http-server-can-listen?) 0 1))
450 (test-assert "home-page: 301 -> 200"
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))))
461 (inherit (dummy-package "x"))
462 (home-page (%local-url)))))
463 (check-home-page pkg)))))))
464 "permanent redirect")))
466 (test-skip (if (http-server-can-listen?) 0 1))
467 (test-assert "home-page: 301 -> 404"
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))))
478 (inherit (dummy-package "x"))
479 (home-page (%local-url)))))
480 (check-home-page pkg)))))))
481 "not reachable: 404")))
483 (test-assert "source-file-name"
487 (let ((pkg (dummy-package "x"
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")))
497 (test-assert "source-file-name: v prefix"
501 (let ((pkg (dummy-package "x"
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")))
511 (test-assert "source-file-name: bad checkout"
515 (let ((pkg (dummy-package "x"
521 (url "http://www.example.com/x.git")
523 (sha256 %null-sha256))))))
524 (check-source-file-name pkg)))
525 "file name should contain the package name")))
527 (test-assert "source-file-name: good checkout"
532 (let ((pkg (dummy-package "x"
538 (url "http://git.example.com/x.git")
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"))))
545 (test-assert "source-file-name: valid"
550 (let ((pkg (dummy-package "x"
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"))))
560 (test-skip (if (http-server-can-listen?) 0 1))
561 (test-equal "source: 200"
564 (with-http-server 200 %long-string
566 (inherit (dummy-package "x"))
570 (sha256 %null-sha256))))))
571 (check-source pkg)))))
573 (test-skip (if (http-server-can-listen?) 0 1))
574 (test-assert "source: 200 but short length"
578 (with-http-server 200 "This is too small."
580 (inherit (dummy-package "x"))
584 (sha256 %null-sha256))))))
585 (check-source pkg))))
586 "suspiciously small")))
588 (test-skip (if (http-server-can-listen?) 0 1))
589 (test-assert "source: 404"
593 (with-http-server 404 %long-string
595 (inherit (dummy-package "x"))
599 (sha256 %null-sha256))))))
600 (check-source pkg))))
601 "not reachable: 404")))
603 (test-skip (if (http-server-can-listen?) 0 1))
604 (test-equal "source: 301 -> 200"
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))))
613 (inherit (dummy-package "x"))
617 (sha256 %null-sha256))))))
618 (check-source pkg))))))))
620 (test-skip (if (http-server-can-listen?) 0 1))
621 (test-assert "source: 301 -> 404"
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))))
631 (inherit (dummy-package "x"))
635 (sha256 %null-sha256))))))
636 (check-source pkg)))))))
637 "not reachable: 404")))
639 (test-assert "mirror-url"
642 (let ((source (origin
644 (uri "http://example.org/foo/bar.tar.gz")
645 (sha256 %null-sha256))))
646 (check-mirror-url (dummy-package "x" (source source)))))))
648 (test-assert "mirror-url: one suggestion"
651 (let ((source (origin
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"))
659 (mock ((guix scripts lint) package-vulnerabilities (const '()))
661 (with-warnings (check-vulnerabilities (dummy-package "x"))))))
663 (test-assert "cve: one vulnerability"
664 (mock ((guix scripts lint) package-vulnerabilities
666 (list (make-struct (@@ (guix cve) <vulnerability>) 0
668 (list (cons (package-name package)
669 (package-version package)))))))
672 (check-vulnerabilities (dummy-package "pi" (version "3.14"))))
673 "vulnerable to CVE-2015-1234")))
675 (test-assert "cve: one patched vulnerability"
676 (mock ((guix scripts lint) package-vulnerabilities
678 (list (make-struct (@@ (guix cve) <vulnerability>) 0
680 (list (cons (package-name package)
681 (package-version package)))))))
684 (check-vulnerabilities
690 (list "/a/b/pi-CVE-2015-1234.patch"))))))))))
692 (test-assert "cve: vulnerability fixed in replacement version"
693 (mock ((guix scripts lint) package-vulnerabilities
695 (match (package-version package)
697 (list (make-struct (@@ (guix cve) <vulnerability>) 0
699 (list (cons (package-name package)
700 (package-version package))))))
703 (and (not (string-null?
705 (check-vulnerabilities
706 (dummy-package "foo" (version "0"))))))
709 (check-vulnerabilities
712 (replacement (dummy-package "foo" (version "1"))))))))))
714 (test-assert "cve: patched vulnerability in replacement"
715 (mock ((guix scripts lint) package-vulnerabilities
717 (list (make-struct (@@ (guix cve) <vulnerability>) 0
719 (list (cons (package-name package)
720 (package-version package)))))))
723 (check-vulnerabilities
725 "pi" (version "3.14") (source (dummy-origin))
726 (replacement (dummy-package
727 "pi" (version "3.14")
731 (list "/a/b/pi-CVE-2015-1234.patch"))))))))))))
733 (test-assert "formatting: lonely parentheses"
738 dummy-package "ugly as hell!"
743 (test-assert "formatting: tabulation"
746 (check-formatting (dummy-package "leave the tab here: ")))
749 (test-assert "formatting: trailing white space"
752 ;; Leave the trailing white space on the next line!
753 (check-formatting (dummy-package "x")))
754 "trailing white space"))
756 (test-assert "formatting: long line"
760 (dummy-package "x" ;here is a stupid comment just to make a long line
764 (test-assert "formatting: alright"
767 (check-formatting (dummy-package "x")))))
772 ;; eval: (put 'with-http-server 'scheme-indent-function 2)
773 ;; eval: (put 'with-warnings 'scheme-indent-function 0)