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>
7 ;;; This file is part of GNU Guix.
9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
10 ;;; under the terms of the GNU General Public License as published by
11 ;;; the Free Software Foundation; either version 3 of the License, or (at
12 ;;; your option) any later version.
14 ;;; GNU Guix is distributed in the hope that it will be useful, but
15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;;; GNU General Public License for more details.
19 ;;; You should have received a copy of the GNU General Public License
20 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
22 ;; Avoid interference.
23 (unsetenv "http_proxy")
25 (define-module (test-lint)
26 #:use-module (guix tests)
27 #:use-module (guix tests http)
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 (ice-9 match)
38 #:use-module (srfi srfi-9 gnu)
39 #:use-module (srfi srfi-64))
43 ;; Avoid collisions with other tests.
44 (%http-server-port 9999)
47 ;; SHA256 of the empty string.
49 "0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73"))
52 (make-string 2000 #\a))
57 (define (call-with-warnings thunk)
58 (let ((port (open-output-string)))
59 (parameterize ((guix-warning-port port))
61 (get-output-string port)))
63 (define-syntax-rule (with-warnings body ...)
64 (call-with-warnings (lambda () body ...)))
66 (test-assert "description: not a string"
68 (string-contains (with-warnings
69 (let ((pkg (dummy-package "x"
70 (description 'foobar))))
71 (check-description-style pkg)))
72 "invalid description")))
74 (test-assert "description: not empty"
76 (string-contains (with-warnings
77 (let ((pkg (dummy-package "x"
79 (check-description-style pkg)))
80 "description should not be empty")))
82 (test-assert "description: valid Texinfo markup"
86 (check-description-style (dummy-package "x" (description "f{oo}b@r"))))
87 "Texinfo markup in description is invalid")))
89 (test-assert "description: does not start with an upper-case letter"
91 (string-contains (with-warnings
92 (let ((pkg (dummy-package "x"
93 (description "bad description."))))
94 (check-description-style pkg)))
95 "description should start with an upper-case letter")))
97 (test-assert "description: may start with a digit"
100 (let ((pkg (dummy-package "x"
101 (description "2-component library."))))
102 (check-description-style pkg)))))
104 (test-assert "description: may start with lower-case package name"
107 (let ((pkg (dummy-package "x"
108 (description "x is a dummy package."))))
109 (check-description-style pkg)))))
111 (test-assert "description: two spaces after end of sentence"
113 (string-contains (with-warnings
114 (let ((pkg (dummy-package "x"
115 (description "Bad. Quite bad."))))
116 (check-description-style pkg)))
117 "sentences in description should be followed by two spaces")))
119 (test-assert "description: end-of-sentence detection with abbreviations"
122 (let ((pkg (dummy-package "x"
124 "E.g. Foo, i.e. Bar resp. Baz (a.k.a. DVD)."))))
125 (check-description-style pkg)))))
127 (test-assert "description: may not contain trademark signs"
129 (string-contains (with-warnings
130 (let ((pkg (dummy-package "x"
131 (description "Does The Right Thing™"))))
132 (check-description-style pkg)))
133 "should not contain trademark sign"))
135 (string-contains (with-warnings
136 (let ((pkg (dummy-package "x"
137 (description "Works with Format®"))))
138 (check-description-style pkg)))
139 "should not contain trademark sign"))))
141 (test-assert "description: suggest ornament instead of quotes"
143 (string-contains (with-warnings
144 (let ((pkg (dummy-package "x"
145 (description "This is a 'quoted' thing."))))
146 (check-description-style pkg)))
149 (test-assert "synopsis: not a string"
151 (string-contains (with-warnings
152 (let ((pkg (dummy-package "x"
154 (check-synopsis-style pkg)))
155 "invalid synopsis")))
157 (test-assert "synopsis: not empty"
159 (string-contains (with-warnings
160 (let ((pkg (dummy-package "x"
162 (check-synopsis-style pkg)))
163 "synopsis should not be empty")))
165 (test-assert "synopsis: does not start with an upper-case letter"
167 (string-contains (with-warnings
168 (let ((pkg (dummy-package "x"
169 (synopsis "bad synopsis."))))
170 (check-synopsis-style pkg)))
171 "synopsis should start with an upper-case letter")))
173 (test-assert "synopsis: may start with a digit"
176 (let ((pkg (dummy-package "x"
177 (synopsis "5-dimensional frobnicator"))))
178 (check-synopsis-style pkg)))))
180 (test-assert "synopsis: ends with a period"
182 (string-contains (with-warnings
183 (let ((pkg (dummy-package "x"
184 (synopsis "Bad synopsis."))))
185 (check-synopsis-style pkg)))
186 "no period allowed at the end of the synopsis")))
188 (test-assert "synopsis: ends with 'etc.'"
189 (string-null? (with-warnings
190 (let ((pkg (dummy-package "x"
191 (synopsis "Foo, bar, etc."))))
192 (check-synopsis-style pkg)))))
194 (test-assert "synopsis: starts with 'A'"
196 (string-contains (with-warnings
197 (let ((pkg (dummy-package "x"
198 (synopsis "A bad synopŝis"))))
199 (check-synopsis-style pkg)))
200 "no article allowed at the beginning of the synopsis")))
202 (test-assert "synopsis: starts with 'An'"
204 (string-contains (with-warnings
205 (let ((pkg (dummy-package "x"
206 (synopsis "An awful synopsis"))))
207 (check-synopsis-style pkg)))
208 "no article allowed at the beginning of the synopsis")))
210 (test-assert "synopsis: starts with 'a'"
212 (string-contains (with-warnings
213 (let ((pkg (dummy-package "x"
214 (synopsis "a bad synopsis"))))
215 (check-synopsis-style pkg)))
216 "no article allowed at the beginning of the synopsis")))
218 (test-assert "synopsis: starts with 'an'"
220 (string-contains (with-warnings
221 (let ((pkg (dummy-package "x"
222 (synopsis "an awful synopsis"))))
223 (check-synopsis-style pkg)))
224 "no article allowed at the beginning of the synopsis")))
226 (test-assert "synopsis: too long"
228 (string-contains (with-warnings
229 (let ((pkg (dummy-package "x"
230 (synopsis (make-string 80 #\x)))))
231 (check-synopsis-style pkg)))
232 "synopsis should be less than 80 characters long")))
234 (test-assert "synopsis: start with package name"
236 (string-contains (with-warnings
237 (let ((pkg (dummy-package "x"
239 (synopsis "foo, a nice package"))))
240 (check-synopsis-style pkg)))
241 "synopsis should not start with the package name")))
243 (test-assert "synopsis: start with package name prefix"
246 (let ((pkg (dummy-package "arb"
247 (synopsis "Arbitrary precision"))))
248 (check-synopsis-style pkg)))))
250 (test-assert "synopsis: start with abbreviation"
253 (let ((pkg (dummy-package "uucp"
254 ;; Same problem with "APL interpreter", etc.
255 (synopsis "UUCP implementation")
256 (description "Imagine this is Taylor UUCP."))))
257 (check-synopsis-style pkg)))))
259 (test-assert "inputs: pkg-config is probably a native input"
263 (let ((pkg (dummy-package "x"
264 (inputs `(("pkg-config" ,pkg-config))))))
265 (check-inputs-should-be-native pkg)))
266 "'pkg-config' should probably be a native input")))
268 (test-assert "inputs: glib:bin is probably a native input"
272 (let ((pkg (dummy-package "x"
273 (inputs `(("glib" ,glib "bin"))))))
274 (check-inputs-should-be-native pkg)))
275 "'glib:bin' should probably be a native input")))
277 (test-assert "patches: file names"
281 (let ((pkg (dummy-package "x"
284 (patches (list "/path/to/y.patch")))))))
285 (check-patch-file-names pkg)))
286 "file names of patches should start with the package name")))
288 (test-assert "patches: not found"
292 (let ((pkg (dummy-package "x"
296 (list (search-patch "this-patch-does-not-exist!"))))))))
297 (check-patch-file-names pkg)))
300 (test-assert "derivation: invalid arguments"
304 (let ((pkg (dummy-package "x"
306 '(#:imported-modules (invalid-module))))))
307 (check-derivation pkg)))
308 "failed to create derivation")))
310 (test-assert "license: invalid license"
313 (check-license (dummy-package "x" (license #f))))
316 (test-assert "home-page: wrong home-page"
321 (inherit (dummy-package "x"))
323 (check-home-page pkg)))
326 (test-assert "home-page: invalid URI"
331 (inherit (dummy-package "x"))
332 (home-page "foobar"))))
333 (check-home-page pkg)))
334 "invalid home page URL")))
336 (test-assert "home-page: host not found"
341 (inherit (dummy-package "x"))
342 (home-page "http://does-not-exist"))))
343 (check-home-page pkg)))
344 "domain not found")))
346 (test-skip (if (force %http-server-socket) 0 1))
347 (test-assert "home-page: Connection refused"
352 (inherit (dummy-package "x"))
353 (home-page (%local-url)))))
354 (check-home-page pkg)))
355 "Connection refused")))
357 (test-skip (if (force %http-server-socket) 0 1))
358 (test-equal "home-page: 200"
361 (with-http-server 200 %long-string
363 (inherit (dummy-package "x"))
364 (home-page (%local-url)))))
365 (check-home-page pkg)))))
367 (test-skip (if (force %http-server-socket) 0 1))
368 (test-assert "home-page: 200 but short length"
372 (with-http-server 200 "This is too small."
374 (inherit (dummy-package "x"))
375 (home-page (%local-url)))))
376 (check-home-page pkg))))
377 "suspiciously small")))
379 (test-skip (if (force %http-server-socket) 0 1))
380 (test-assert "home-page: 404"
384 (with-http-server 404 %long-string
386 (inherit (dummy-package "x"))
387 (home-page (%local-url)))))
388 (check-home-page pkg))))
389 "not reachable: 404")))
391 (test-assert "source-file-name"
395 (let ((pkg (dummy-package "x"
400 (uri "http://www.example.com/3.2.1.tar.gz")
401 (sha256 %null-sha256))))))
402 (check-source-file-name pkg)))
403 "file name should contain the package name")))
405 (test-assert "source-file-name: v prefix"
409 (let ((pkg (dummy-package "x"
414 (uri "http://www.example.com/v3.2.1.tar.gz")
415 (sha256 %null-sha256))))))
416 (check-source-file-name pkg)))
417 "file name should contain the package name")))
419 (test-assert "source-file-name: bad checkout"
423 (let ((pkg (dummy-package "x"
429 (url "http://www.example.com/x.git")
431 (sha256 %null-sha256))))))
432 (check-source-file-name pkg)))
433 "file name should contain the package name")))
435 (test-assert "source-file-name: good checkout"
440 (let ((pkg (dummy-package "x"
446 (url "http://git.example.com/x.git")
448 (file-name (string-append "x-" version))
449 (sha256 %null-sha256))))))
450 (check-source-file-name pkg)))
451 "file name should contain the package name"))))
453 (test-assert "source-file-name: valid"
458 (let ((pkg (dummy-package "x"
463 (uri "http://www.example.com/x-3.2.1.tar.gz")
464 (sha256 %null-sha256))))))
465 (check-source-file-name pkg)))
466 "file name should contain the package name"))))
468 (test-skip (if (force %http-server-socket) 0 1))
469 (test-equal "source: 200"
472 (with-http-server 200 %long-string
474 (inherit (dummy-package "x"))
478 (sha256 %null-sha256))))))
479 (check-source pkg)))))
481 (test-skip (if (force %http-server-socket) 0 1))
482 (test-assert "source: 200 but short length"
486 (with-http-server 200 "This is too small."
488 (inherit (dummy-package "x"))
492 (sha256 %null-sha256))))))
493 (check-source pkg))))
494 "suspiciously small")))
496 (test-skip (if (force %http-server-socket) 0 1))
497 (test-assert "source: 404"
501 (with-http-server 404 %long-string
503 (inherit (dummy-package "x"))
507 (sha256 %null-sha256))))))
508 (check-source pkg))))
509 "not reachable: 404")))
512 (mock ((guix scripts lint) package-vulnerabilities (const '()))
514 (with-warnings (check-vulnerabilities (dummy-package "x"))))))
516 (test-assert "cve: one vulnerability"
517 (mock ((guix scripts lint) package-vulnerabilities
519 (list (make-struct (@@ (guix cve) <vulnerability>) 0
521 (list (cons (package-name package)
522 (package-version package)))))))
525 (check-vulnerabilities (dummy-package "pi" (version "3.14"))))
526 "vulnerable to CVE-2015-1234")))
528 (test-assert "cve: one patched vulnerability"
529 (mock ((guix scripts lint) package-vulnerabilities
531 (list (make-struct (@@ (guix cve) <vulnerability>) 0
533 (list (cons (package-name package)
534 (package-version package)))))))
537 (check-vulnerabilities
543 (list "/a/b/pi-CVE-2015-1234.patch"))))))))))
545 (test-assert "cve: vulnerability fixed in replacement version"
546 (mock ((guix scripts lint) package-vulnerabilities
548 (match (package-version package)
550 (list (make-struct (@@ (guix cve) <vulnerability>) 0
552 (list (cons (package-name package)
553 (package-version package))))))
556 (and (not (string-null?
558 (check-vulnerabilities
559 (dummy-package "foo" (version "0"))))))
562 (check-vulnerabilities
565 (replacement (dummy-package "foo" (version "1"))))))))))
567 (test-assert "cve: patched vulnerability in replacement"
568 (mock ((guix scripts lint) package-vulnerabilities
570 (list (make-struct (@@ (guix cve) <vulnerability>) 0
572 (list (cons (package-name package)
573 (package-version package)))))))
576 (check-vulnerabilities
578 "pi" (version "3.14") (source (dummy-origin))
579 (replacement (dummy-package
580 "pi" (version "3.14")
584 (list "/a/b/pi-CVE-2015-1234.patch"))))))))))))
586 (test-assert "formatting: lonely parentheses"
591 dummy-package "ugly as hell!"
596 (test-assert "formatting: tabulation"
599 (check-formatting (dummy-package "leave the tab here: ")))
602 (test-assert "formatting: trailing white space"
605 ;; Leave the trailing white space on the next line!
606 (check-formatting (dummy-package "x")))
607 "trailing white space"))
609 (test-assert "formatting: long line"
613 (dummy-package "x" ;here is a stupid comment just to make a long line
617 (test-assert "formatting: alright"
620 (check-formatting (dummy-package "x")))))
625 ;; eval: (put 'with-http-server 'scheme-indent-function 2)
626 ;; eval: (put 'with-warnings 'scheme-indent-function 0)