lint: 'check-derivation' tries all the package's supported systems.
[jackhill/guix/guix.git] / tests / lint.scm
CommitLineData
b4f5e0e8
CR
1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
83f18e06 3;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org>
3b32891b 4;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
052d53df 5;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
891a843d 6;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
689db38e 7;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
f4007b25 8;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
b4f5e0e8
CR
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
c74f0cb2
LC
25;; Avoid interference.
26(unsetenv "http_proxy")
27
4e7b6b48 28(define-module (test-lint)
8b385969 29 #:use-module (guix tests)
17ab08bc 30 #:use-module (guix tests http)
754e5be2 31 #:use-module (guix download)
50f5c46d 32 #:use-module (guix git-download)
b4f5e0e8
CR
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)
99fe215c 38 #:use-module (gnu packages glib)
b4f5e0e8 39 #:use-module (gnu packages pkg-config)
891a843d 40 #:use-module (gnu packages python)
61f28fe7 41 #:use-module (web uri)
907c98ac
LC
42 #:use-module (web server)
43 #:use-module (web server http)
44 #:use-module (web response)
9bee2bd1 45 #:use-module (ice-9 match)
907c98ac 46 #:use-module (srfi srfi-9 gnu)
b4f5e0e8
CR
47 #:use-module (srfi srfi-64))
48
49;; Test the linter.
50
17ab08bc
LC
51;; Avoid collisions with other tests.
52(%http-server-port 9999)
907c98ac 53
950d2ea4
LC
54(define %null-sha256
55 ;; SHA256 of the empty string.
56 (base32
57 "0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73"))
58
bfcb3d76
LC
59(define %long-string
60 (make-string 2000 #\a))
907c98ac 61
b4f5e0e8
CR
62\f
63(test-begin "lint")
64
b4f5e0e8 65(define (call-with-warnings thunk)
b002e9d0
LC
66 (let ((port (open-output-string)))
67 (parameterize ((guix-warning-port port))
68 (thunk))
69 (get-output-string port)))
b4f5e0e8 70
4fbf4ca5
LC
71(define-syntax-rule (with-warnings body ...)
72 (call-with-warnings (lambda () body ...)))
73
20be23c3
LC
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
334c43e3
EB
82(test-assert "description: not empty"
83 (->bool
4fbf4ca5
LC
84 (string-contains (with-warnings
85 (let ((pkg (dummy-package "x"
86 (description ""))))
87 (check-description-style pkg)))
334c43e3
EB
88 "description should not be empty")))
89
3500e659
ML
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
8202a513
CR
97(test-assert "description: does not start with an upper-case letter"
98 (->bool
4fbf4ca5
LC
99 (string-contains (with-warnings
100 (let ((pkg (dummy-package "x"
101 (description "bad description."))))
102 (check-description-style pkg)))
8202a513
CR
103 "description should start with an upper-case letter")))
104
903581f9 105(test-assert "description: may start with a digit"
b1e66683 106 (string-null?
4fbf4ca5
LC
107 (with-warnings
108 (let ((pkg (dummy-package "x"
109 (description "2-component library."))))
110 (check-description-style pkg)))))
903581f9 111
3c42965b 112(test-assert "description: may start with lower-case package name"
b1e66683 113 (string-null?
4fbf4ca5
LC
114 (with-warnings
115 (let ((pkg (dummy-package "x"
116 (description "x is a dummy package."))))
117 (check-description-style pkg)))))
3c42965b 118
574e847b
EB
119(test-assert "description: two spaces after end of sentence"
120 (->bool
4fbf4ca5
LC
121 (string-contains (with-warnings
122 (let ((pkg (dummy-package "x"
123 (description "Bad. Quite bad."))))
124 (check-description-style pkg)))
574e847b
EB
125 "sentences in description should be followed by two spaces")))
126
127(test-assert "description: end-of-sentence detection with abbreviations"
b1e66683 128 (string-null?
4fbf4ca5
LC
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)))))
574e847b 134
83f18e06
EB
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
4bb54cc4
LC
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
20be23c3
LC
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
574e847b
EB
165(test-assert "synopsis: not empty"
166 (->bool
4fbf4ca5
LC
167 (string-contains (with-warnings
168 (let ((pkg (dummy-package "x"
169 (synopsis ""))))
170 (check-synopsis-style pkg)))
574e847b
EB
171 "synopsis should not be empty")))
172
689db38e
AK
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
8202a513
CR
180(test-assert "synopsis: does not start with an upper-case letter"
181 (->bool
4fbf4ca5
LC
182 (string-contains (with-warnings
183 (let ((pkg (dummy-package "x"
184 (synopsis "bad synopsis."))))
185 (check-synopsis-style pkg)))
8202a513
CR
186 "synopsis should start with an upper-case letter")))
187
903581f9 188(test-assert "synopsis: may start with a digit"
b1e66683 189 (string-null?
4fbf4ca5
LC
190 (with-warnings
191 (let ((pkg (dummy-package "x"
192 (synopsis "5-dimensional frobnicator"))))
193 (check-synopsis-style pkg)))))
903581f9 194
b4f5e0e8
CR
195(test-assert "synopsis: ends with a period"
196 (->bool
4fbf4ca5
LC
197 (string-contains (with-warnings
198 (let ((pkg (dummy-package "x"
199 (synopsis "Bad synopsis."))))
200 (check-synopsis-style pkg)))
b4f5e0e8
CR
201 "no period allowed at the end of the synopsis")))
202
203(test-assert "synopsis: ends with 'etc.'"
4fbf4ca5
LC
204 (string-null? (with-warnings
205 (let ((pkg (dummy-package "x"
206 (synopsis "Foo, bar, etc."))))
207 (check-synopsis-style pkg)))))
b4f5e0e8
CR
208
209(test-assert "synopsis: starts with 'A'"
210 (->bool
4fbf4ca5
LC
211 (string-contains (with-warnings
212 (let ((pkg (dummy-package "x"
213 (synopsis "A bad synopŝis"))))
214 (check-synopsis-style pkg)))
b4f5e0e8
CR
215 "no article allowed at the beginning of the synopsis")))
216
217(test-assert "synopsis: starts with 'An'"
218 (->bool
4fbf4ca5
LC
219 (string-contains (with-warnings
220 (let ((pkg (dummy-package "x"
221 (synopsis "An awful synopsis"))))
222 (check-synopsis-style pkg)))
b4f5e0e8
CR
223 "no article allowed at the beginning of the synopsis")))
224
a00ffdaa
CR
225(test-assert "synopsis: starts with 'a'"
226 (->bool
4fbf4ca5
LC
227 (string-contains (with-warnings
228 (let ((pkg (dummy-package "x"
229 (synopsis "a bad synopsis"))))
230 (check-synopsis-style pkg)))
a00ffdaa
CR
231 "no article allowed at the beginning of the synopsis")))
232
233(test-assert "synopsis: starts with 'an'"
234 (->bool
4fbf4ca5
LC
235 (string-contains (with-warnings
236 (let ((pkg (dummy-package "x"
237 (synopsis "an awful synopsis"))))
238 (check-synopsis-style pkg)))
a00ffdaa
CR
239 "no article allowed at the beginning of the synopsis")))
240
5622953d
CR
241(test-assert "synopsis: too long"
242 (->bool
4fbf4ca5
LC
243 (string-contains (with-warnings
244 (let ((pkg (dummy-package "x"
245 (synopsis (make-string 80 #\x)))))
246 (check-synopsis-style pkg)))
5622953d
CR
247 "synopsis should be less than 80 characters long")))
248
3c762a13
CR
249(test-assert "synopsis: start with package name"
250 (->bool
4fbf4ca5
LC
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)))
3c762a13
CR
256 "synopsis should not start with the package name")))
257
17854ef9
LC
258(test-assert "synopsis: start with package name prefix"
259 (string-null?
4fbf4ca5
LC
260 (with-warnings
261 (let ((pkg (dummy-package "arb"
262 (synopsis "Arbitrary precision"))))
263 (check-synopsis-style pkg)))))
17854ef9 264
15a6d433
LC
265(test-assert "synopsis: start with abbreviation"
266 (string-null?
4fbf4ca5
LC
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)))))
15a6d433 273
b4f5e0e8
CR
274(test-assert "inputs: pkg-config is probably a native input"
275 (->bool
276 (string-contains
4fbf4ca5
LC
277 (with-warnings
278 (let ((pkg (dummy-package "x"
279 (inputs `(("pkg-config" ,pkg-config))))))
280 (check-inputs-should-be-native pkg)))
99fe215c
DC
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")))
b4f5e0e8 291
891a843d
HG
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
b4f5e0e8
CR
324(test-assert "patches: file names"
325 (->bool
326 (string-contains
4fbf4ca5
LC
327 (with-warnings
328 (let ((pkg (dummy-package "x"
329 (source
052d53df 330 (dummy-origin
4fbf4ca5 331 (patches (list "/path/to/y.patch")))))))
56b1b74c 332 (check-patch-file-names pkg)))
907c98ac
LC
333 "file names of patches should start with the package name")))
334
eef01cfe
LC
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
b210b35d
LC
348(test-assert "patches: not found"
349 (->bool
350 (string-contains
351 (with-warnings
352 (let ((pkg (dummy-package "x"
353 (source
052d53df 354 (dummy-origin
b210b35d
LC
355 (patches
356 (list (search-patch "this-patch-does-not-exist!"))))))))
357 (check-patch-file-names pkg)))
358 "patch not found")))
359
002c57c6
LC
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)))
3b32891b 368 "failed to create")))
002c57c6 369
52b9efe3
LC
370(test-assert "license: invalid license"
371 (string-contains
372 (with-warnings
373 (check-license (dummy-package "x" (license #f))))
374 "invalid license"))
375
907c98ac
LC
376(test-assert "home-page: wrong home-page"
377 (->bool
378 (string-contains
4fbf4ca5
LC
379 (with-warnings
380 (let ((pkg (package
381 (inherit (dummy-package "x"))
382 (home-page #f))))
383 (check-home-page pkg)))
907c98ac
LC
384 "invalid")))
385
386(test-assert "home-page: invalid URI"
387 (->bool
388 (string-contains
4fbf4ca5
LC
389 (with-warnings
390 (let ((pkg (package
391 (inherit (dummy-package "x"))
392 (home-page "foobar"))))
393 (check-home-page pkg)))
907c98ac
LC
394 "invalid home page URL")))
395
396(test-assert "home-page: host not found"
397 (->bool
398 (string-contains
4fbf4ca5
LC
399 (with-warnings
400 (let ((pkg (package
401 (inherit (dummy-package "x"))
402 (home-page "http://does-not-exist"))))
403 (check-home-page pkg)))
907c98ac
LC
404 "domain not found")))
405
6ea10db9 406(test-skip (if (http-server-can-listen?) 0 1))
907c98ac
LC
407(test-assert "home-page: Connection refused"
408 (->bool
409 (string-contains
4fbf4ca5
LC
410 (with-warnings
411 (let ((pkg (package
412 (inherit (dummy-package "x"))
17ab08bc 413 (home-page (%local-url)))))
4fbf4ca5 414 (check-home-page pkg)))
907c98ac
LC
415 "Connection refused")))
416
6ea10db9 417(test-skip (if (http-server-can-listen?) 0 1))
907c98ac
LC
418(test-equal "home-page: 200"
419 ""
4fbf4ca5 420 (with-warnings
bfcb3d76 421 (with-http-server 200 %long-string
4fbf4ca5
LC
422 (let ((pkg (package
423 (inherit (dummy-package "x"))
17ab08bc 424 (home-page (%local-url)))))
4fbf4ca5 425 (check-home-page pkg)))))
907c98ac 426
6ea10db9 427(test-skip (if (http-server-can-listen?) 0 1))
bfcb3d76
LC
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"))
17ab08bc 435 (home-page (%local-url)))))
bfcb3d76
LC
436 (check-home-page pkg))))
437 "suspiciously small")))
438
6ea10db9 439(test-skip (if (http-server-can-listen?) 0 1))
907c98ac
LC
440(test-assert "home-page: 404"
441 (->bool
442 (string-contains
4fbf4ca5 443 (with-warnings
bfcb3d76 444 (with-http-server 404 %long-string
4fbf4ca5
LC
445 (let ((pkg (package
446 (inherit (dummy-package "x"))
17ab08bc 447 (home-page (%local-url)))))
4fbf4ca5 448 (check-home-page pkg))))
907c98ac 449 "not reachable: 404")))
b4f5e0e8 450
61f28fe7
LC
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
50f5c46d
EB
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
6ea10db9 574(test-skip (if (http-server-can-listen?) 0 1))
950d2ea4
LC
575(test-equal "source: 200"
576 ""
577 (with-warnings
bfcb3d76 578 (with-http-server 200 %long-string
950d2ea4
LC
579 (let ((pkg (package
580 (inherit (dummy-package "x"))
581 (source (origin
582 (method url-fetch)
17ab08bc 583 (uri (%local-url))
950d2ea4
LC
584 (sha256 %null-sha256))))))
585 (check-source pkg)))))
586
6ea10db9 587(test-skip (if (http-server-can-listen?) 0 1))
bfcb3d76
LC
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)
17ab08bc 597 (uri (%local-url))
bfcb3d76
LC
598 (sha256 %null-sha256))))))
599 (check-source pkg))))
600 "suspiciously small")))
601
6ea10db9 602(test-skip (if (http-server-can-listen?) 0 1))
950d2ea4
LC
603(test-assert "source: 404"
604 (->bool
605 (string-contains
606 (with-warnings
bfcb3d76 607 (with-http-server 404 %long-string
950d2ea4
LC
608 (let ((pkg (package
609 (inherit (dummy-package "x"))
610 (source (origin
611 (method url-fetch)
17ab08bc 612 (uri (%local-url))
950d2ea4
LC
613 (sha256 %null-sha256))))))
614 (check-source pkg))))
615 "not reachable: 404")))
616
61f28fe7
LC
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
fac46e3f
LC
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
5432734b
LC
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
4e70fe4d
LC
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
f4007b25
EF
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
9bee2bd1
LC
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
5c6a062d
LC
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
e0566f12
LC
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
40a7d4e5
LC
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
b4f5e0e8
CR
797(test-end "lint")
798
907c98ac 799;; Local Variables:
bfcb3d76 800;; eval: (put 'with-http-server 'scheme-indent-function 2)
4fbf4ca5 801;; eval: (put 'with-warnings 'scheme-indent-function 0)
907c98ac 802;; End: