1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
7 ;;; under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 3 of the License, or (at
9 ;;; your option) any later version.
11 ;;; GNU Guix is distributed in the hope that it will be useful, but
12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;; GNU General Public License for more details.
16 ;;; You should have received a copy of the GNU General Public License
17 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19 (unsetenv "http_proxy")
21 (define-module (test-derivations)
22 #:use-module (guix derivations)
23 #:use-module (guix grafts)
24 #:use-module (guix store)
25 #:use-module (guix utils)
26 #:use-module ((gcrypt hash) #:prefix gcrypt:)
27 #:use-module (guix base32)
28 #:use-module (guix tests)
29 #:use-module (guix tests http)
30 #:use-module ((guix packages) #:select (package-derivation base32))
31 #:use-module ((guix build utils) #:select (executable-file?))
32 #:use-module (gnu packages bootstrap)
33 #:use-module ((gnu packages guile) #:select (guile-1.8))
34 #:use-module (srfi srfi-1)
35 #:use-module (srfi srfi-11)
36 #:use-module (srfi srfi-26)
37 #:use-module (srfi srfi-34)
38 #:use-module (srfi srfi-64)
39 #:use-module (rnrs io ports)
40 #:use-module (rnrs bytevectors)
41 #:use-module (web uri)
42 #:use-module (ice-9 rdelim)
43 #:use-module (ice-9 regex)
44 #:use-module (ice-9 ftw)
45 #:use-module (ice-9 match))
48 (open-connection-for-tests))
50 ;; Globally disable grafts because they can trigger early builds.
53 (define (bootstrap-binary name)
54 (let ((bin (search-bootstrap-binary name (%current-system))))
56 (add-to-store %store name #t "sha256" bin))))
59 (bootstrap-binary "bash"))
61 (bootstrap-binary "mkdir"))
63 (define* (directory-contents dir #:optional (slurp get-bytevector-all))
64 "Return an alist representing the contents of DIR."
65 (define prefix-len (string-length dir))
66 (sort (file-system-fold (const #t) ; enter?
67 (lambda (path stat result) ; leaf
68 (alist-cons (string-drop path prefix-len)
69 (call-with-input-file path slurp)
71 (lambda (path stat result) result) ; down
72 (lambda (path stat result) result) ; up
73 (lambda (path stat result) result) ; skip
74 (lambda (path stat errno result) result) ; error
78 (string<? (car e1) (car e2)))))
80 ;; Avoid collisions with other tests.
81 (%http-server-port 10500)
84 (test-begin "derivations")
86 (test-assert "parse & export"
87 (let* ((f (search-path %load-path "tests/test.drv"))
88 (b1 (call-with-input-file f get-bytevector-all))
89 (d1 (read-derivation (open-bytevector-input-port b1)
91 (b2 (call-with-bytevector-output-port (cut write-derivation d1 <>)))
92 (d2 (read-derivation (open-bytevector-input-port b2)
97 (test-skip (if %store 0 12))
99 (test-assert "add-to-store, flat"
100 ;; Use 'readlink*' in case spec.scm is a symlink, as is the case when Guile
101 ;; was installed with Stow.
102 (let* ((file (readlink*
103 (search-path %load-path "language/tree-il/spec.scm")))
104 (drv (add-to-store %store "flat-test" #f "sha256" file)))
105 (and (eq? 'regular (stat:type (stat drv)))
106 (valid-path? %store drv)
107 (equal? (call-with-input-file file get-bytevector-all)
108 (call-with-input-file drv get-bytevector-all)))))
110 (test-assert "add-to-store, recursive"
112 (readlink* (search-path %load-path
113 "language/tree-il/spec.scm"))))
114 (drv (add-to-store %store "dir-tree-test" #t "sha256" dir)))
115 (and (eq? 'directory (stat:type (stat drv)))
116 (valid-path? %store drv)
117 (equal? (directory-contents dir)
118 (directory-contents drv)))))
120 (test-assert "derivation with no inputs"
121 (let* ((builder (add-text-to-store %store "my-builder.sh"
122 "echo hello, world\n"
124 (drv (derivation %store "foo"
125 %bash `("-e" ,builder)
126 #:env-vars '(("HOME" . "/homeless")))))
127 (and (store-path? (derivation-file-name drv))
128 (valid-path? %store (derivation-file-name drv)))))
130 (test-assert "build derivation with 1 source"
131 (let* ((builder (add-text-to-store %store "my-builder.sh"
132 "echo hello, world > \"$out\"\n"
134 (drv (derivation %store "foo"
136 #:env-vars '(("HOME" . "/homeless")
139 #:sources `(,%bash ,builder)))
141 (build-derivations %store (list drv))))
143 (let ((path (derivation->output-path drv)))
144 (and (valid-path? %store path)
145 (string=? (call-with-input-file path read-line)
148 (test-assert "derivation fails but keep going"
149 ;; In keep-going mode, 'build-derivations' should fail because of D1, but it
150 ;; must return only after D2 has succeeded.
152 (let* ((d1 (derivation %store "fails"
153 %bash `("-c" "false")
154 #:sources (list %bash)))
155 (d2 (build-expression->derivation %store "sleep-then-succeed"
158 ;; XXX: Hopefully that's long
159 ;; enough that D1 has already
163 (set-build-options %store
164 #:use-substitutes? #f
166 (guard (c ((store-protocol-error? c)
167 (and (= 100 (store-protocol-error-status c))
168 (string-contains (store-protocol-error-message c)
169 (derivation-file-name d1))
170 (not (valid-path? %store (derivation->output-path d1)))
171 (valid-path? %store (derivation->output-path d2)))))
172 (build-derivations %store (list d1 d2))
175 (test-assert "identical files are deduplicated"
176 (let* ((build1 (add-text-to-store %store "one.sh"
177 "echo hello, world > \"$out\"\n"
179 (build2 (add-text-to-store %store "two.sh"
180 "# Hey!\necho hello, world > \"$out\"\n"
182 (drv1 (derivation %store "foo"
184 #:sources `(,%bash ,build1)))
185 (drv2 (derivation %store "bar"
187 #:sources `(,%bash ,build2))))
188 (and (build-derivations %store (list drv1 drv2))
189 (let ((file1 (derivation->output-path drv1))
190 (file2 (derivation->output-path drv2)))
191 (and (valid-path? %store file1) (valid-path? %store file2)
192 (string=? (call-with-input-file file1 get-string-all)
194 (= (stat:ino (lstat file1))
195 (stat:ino (lstat file2))))))))
197 (test-equal "built-in-builders"
199 (built-in-builders %store))
201 (test-assert "unknown built-in builder"
202 (let ((drv (derivation %store "ohoh" "builtin:does-not-exist" '())))
203 (guard (c ((store-protocol-error? c)
204 (string-contains (store-protocol-error-message c) "failed")))
205 (build-derivations %store (list drv))
208 (unless (http-server-can-listen?)
210 (test-assert "'download' built-in builder"
211 (let ((text (random-text)))
212 (with-http-server `((200 ,text))
213 (let* ((drv (derivation %store "world"
214 "builtin:download" '()
216 . ,(object->string (%local-url))))
218 #:hash (gcrypt:sha256 (string->utf8 text)))))
219 (and (build-derivations %store (list drv))
220 (string=? (call-with-input-file (derivation->output-path drv)
224 (unless (http-server-can-listen?)
226 (test-assert "'download' built-in builder, invalid hash"
227 (with-http-server `((200 "hello, world!"))
228 (let* ((drv (derivation %store "world"
229 "builtin:download" '()
231 . ,(object->string (%local-url))))
233 #:hash (gcrypt:sha256 (random-bytevector 100))))) ;wrong
234 (guard (c ((store-protocol-error? c)
235 (string-contains (store-protocol-error-message c) "failed")))
236 (build-derivations %store (list drv))
239 (unless (http-server-can-listen?)
241 (test-assert "'download' built-in builder, not found"
242 (with-http-server '((404 "not found"))
243 (let* ((drv (derivation %store "will-never-be-found"
244 "builtin:download" '()
246 . ,(object->string (%local-url))))
248 #:hash (gcrypt:sha256 (random-bytevector 100)))))
249 (guard (c ((store-protocol-error? c)
250 (string-contains (store-protocol-error-message (pk c)) "failed")))
251 (build-derivations %store (list drv))
254 (test-assert "'download' built-in builder, not fixed-output"
255 (let* ((source (add-text-to-store %store "hello" "hi!"))
256 (url (string-append "file://" source))
257 (drv (derivation %store "world"
258 "builtin:download" '()
259 #:env-vars `(("url" . ,(object->string url))))))
260 (guard (c ((store-protocol-error? c)
261 (string-contains (store-protocol-error-message c) "failed")))
262 (build-derivations %store (list drv))
265 (unless (http-server-can-listen?)
267 (test-assert "'download' built-in builder, check mode"
268 ;; Make sure rebuilding the 'builtin:download' derivation in check mode
269 ;; works. See <http://bugs.gnu.org/25089>.
270 (let* ((text (random-text))
271 (drv (derivation %store "world"
272 "builtin:download" '()
274 . ,(object->string (%local-url))))
276 #:hash (gcrypt:sha256 (string->utf8 text)))))
277 (and (with-http-server `((200 ,text))
278 (build-derivations %store (list drv)))
279 (with-http-server `((200 ,text))
280 (build-derivations %store (list drv)
282 (string=? (call-with-input-file (derivation->output-path drv)
286 (test-equal "derivation-name"
288 (let ((drv (derivation %store "foo-0.0" %bash '())))
289 (derivation-name drv)))
291 (test-equal "derivation-output-names"
292 '(("out") ("bar" "chbouib"))
293 (let ((drv1 (derivation %store "foo-0.0" %bash '()))
294 (drv2 (derivation %store "foo-0.0" %bash '()
295 #:outputs '("bar" "chbouib"))))
296 (list (derivation-output-names drv1)
297 (derivation-output-names drv2))))
299 (test-assert "offloadable-derivation?"
300 (and (offloadable-derivation? (derivation %store "foo" %bash '()))
301 (offloadable-derivation? ;see <http://bugs.gnu.org/18747>
302 (derivation %store "foo" %bash '()
303 #:substitutable? #f))
304 (not (offloadable-derivation?
305 (derivation %store "foo" %bash '()
306 #:local-build? #t)))))
308 (test-assert "substitutable-derivation?"
309 (and (substitutable-derivation? (derivation %store "foo" %bash '()))
310 (substitutable-derivation? ;see <http://bugs.gnu.org/18747>
311 (derivation %store "foo" %bash '()
313 (not (substitutable-derivation?
314 (derivation %store "foo" %bash '()
315 #:substitutable? #f)))))
317 (test-assert "fixed-output-derivation?"
318 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
319 "echo -n hello > $out" '()))
320 (hash (gcrypt:sha256 (string->utf8 "hello")))
321 (drv (derivation %store "fixed"
323 #:sources (list builder)
324 #:hash hash #:hash-algo 'sha256)))
325 (fixed-output-derivation? drv)))
327 (test-equal "fixed-output derivation"
328 '(sha1 sha256 sha512)
329 (map (lambda (hash-algorithm)
330 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
331 "echo -n hello > $out" '()))
332 (sha256 (gcrypt:sha256 (string->utf8 "hello")))
333 (hash (gcrypt:bytevector-hash
334 (string->utf8 "hello")
335 (gcrypt:lookup-hash-algorithm hash-algorithm)))
336 (drv (derivation %store
338 "fixed-" (symbol->string hash-algorithm))
340 #:sources `(,builder) ;optional
342 #:hash-algo hash-algorithm)))
343 (build-derivations %store (list drv))
344 (let ((p (derivation->output-path drv)))
345 (and (bytevector=? (string->utf8 "hello")
346 (call-with-input-file p get-bytevector-all))
347 (bytevector? (query-path-hash %store p))
349 '(sha1 sha256 sha512)))
351 (test-assert "fixed-output derivation: output paths are equal"
352 (let* ((builder1 (add-text-to-store %store "fixed-builder1.sh"
353 "echo -n hello > $out" '()))
354 (builder2 (add-text-to-store %store "fixed-builder2.sh"
355 "echo hey; echo -n hello > $out" '()))
356 (hash (gcrypt:sha256 (string->utf8 "hello")))
357 (drv1 (derivation %store "fixed"
359 #:hash hash #:hash-algo 'sha256))
360 (drv2 (derivation %store "fixed"
362 #:hash hash #:hash-algo 'sha256))
363 (succeeded? (build-derivations %store (list drv1 drv2))))
365 (equal? (derivation->output-path drv1)
366 (derivation->output-path drv2)))))
368 (test-assert "fixed-output derivation, recursive"
369 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
370 "echo -n hello > $out" '()))
371 (hash (gcrypt:sha256 (string->utf8 "hello")))
372 (drv (derivation %store "fixed-rec"
374 #:sources (list builder)
375 #:hash (base32 "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
378 (succeeded? (build-derivations %store (list drv))))
380 (let ((p (derivation->output-path drv)))
381 (and (equal? (string->utf8 "hello")
382 (call-with-input-file p get-bytevector-all))
383 (bytevector? (query-path-hash %store p)))))))
385 (test-assert "derivation with a fixed-output input"
386 ;; A derivation D using a fixed-output derivation F doesn't has the same
387 ;; output path when passed F or F', as long as F and F' have the same output
389 (let* ((builder1 (add-text-to-store %store "fixed-builder1.sh"
390 "echo -n hello > $out" '()))
391 (builder2 (add-text-to-store %store "fixed-builder2.sh"
392 "echo hey; echo -n hello > $out" '()))
393 (hash (gcrypt:sha256 (string->utf8 "hello")))
394 (fixed1 (derivation %store "fixed"
396 #:hash hash #:hash-algo 'sha256))
397 (fixed2 (derivation %store "fixed"
399 #:hash hash #:hash-algo 'sha256))
400 (fixed-out (derivation->output-path fixed1))
401 (builder3 (add-text-to-store
402 %store "final-builder.sh"
403 ;; Use Bash hackery to avoid Coreutils.
404 "echo $in ; (read -u 3 c; echo $c) 3< $in > $out" '()))
405 (final1 (derivation %store "final"
407 #:env-vars `(("in" . ,fixed-out))
408 #:sources (list %bash builder3)
409 #:inputs (list (derivation-input fixed1))))
410 (final2 (derivation %store "final"
412 #:env-vars `(("in" . ,fixed-out))
413 #:sources (list %bash builder3)
414 #:inputs (list (derivation-input fixed2))))
415 (succeeded? (build-derivations %store
416 (list final1 final2))))
418 (equal? (derivation->output-path final1)
419 (derivation->output-path final2)))))
421 (test-assert "derivation with duplicate fixed-output inputs"
422 ;; Here we create a derivation that has two inputs, both of which are
423 ;; fixed-output leading to the same result. This test ensures the hash of
424 ;; that derivation is correctly computed, namely that duplicate inputs are
425 ;; coalesced. See <https://bugs.gnu.org/36777>.
426 (let* ((builder1 (add-text-to-store %store "fixed-builder1.sh"
427 "echo -n hello > $out" '()))
428 (builder2 (add-text-to-store %store "fixed-builder2.sh"
429 "echo hey; echo -n hello > $out" '()))
430 (hash (gcrypt:sha256 (string->utf8 "hello")))
431 (fixed1 (derivation %store "fixed"
433 #:hash hash #:hash-algo 'sha256))
434 (fixed2 (derivation %store "fixed"
436 #:hash hash #:hash-algo 'sha256))
437 (builder3 (add-text-to-store %store "builder.sh"
438 "echo fake builder"))
439 (final (derivation %store "final"
441 #:sources (list %bash builder3)
442 #:inputs (list (derivation-input fixed1)
443 (derivation-input fixed2)))))
444 (and (derivation? final)
445 (match (derivation-inputs final)
446 (((= derivation-input-derivation one)
447 (= derivation-input-derivation two))
448 (and (not (string=? (derivation-file-name one)
449 (derivation-file-name two)))
450 (string=? (derivation->output-path one)
451 (derivation->output-path two))))))))
453 (test-assert "multiple-output derivation"
454 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
455 "echo one > $out ; echo two > $second"
457 (drv (derivation %store "fixed"
459 #:env-vars '(("HOME" . "/homeless")
462 #:sources `(,%bash ,builder)
463 #:outputs '("out" "second")))
464 (succeeded? (build-derivations %store (list drv))))
466 (let ((one (derivation->output-path drv "out"))
467 (two (derivation->output-path drv "second")))
469 (derivation->output-paths drv)
470 `(("out" . ,one) ("second" . ,two)))
471 (eq? 'one (call-with-input-file one read))
472 (eq? 'two (call-with-input-file two read)))))))
474 (test-assert "multiple-output derivation, non-alphabetic order"
475 ;; Here, the outputs are not listed in alphabetic order. Yet, the store
476 ;; path computation must reorder them first.
477 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
478 "echo one > $out ; echo two > $AAA"
480 (drv (derivation %store "fixed"
482 #:sources `(,%bash ,builder)
483 #:outputs '("out" "AAA")))
484 (succeeded? (build-derivations %store (list drv))))
486 (let ((one (derivation->output-path drv "out"))
487 (two (derivation->output-path drv "AAA")))
488 (and (eq? 'one (call-with-input-file one read))
489 (eq? 'two (call-with-input-file two read)))))))
491 (test-assert "read-derivation vs. derivation"
492 ;; Make sure 'derivation' and 'read-derivation' return objects that are
494 (let* ((sources (unfold (cut >= <> 10)
496 (add-text-to-store %store
497 (format #f "input~a" n)
501 (inputs (map (lambda (file)
502 (derivation %store "derivation-input"
504 #:sources `(,%bash ,file)))
506 (builder (add-text-to-store %store "builder.sh"
507 "echo one > $one ; echo two > $two"
509 (drv (derivation %store "derivation"
511 #:sources `(,%bash ,builder ,@sources)
512 #:inputs (map derivation-input inputs)
513 #:outputs '("two" "one")))
514 (drv* (call-with-input-file (derivation-file-name drv)
518 (test-assert "multiple-output derivation, derivation-path->output-path"
519 (let* ((builder (add-text-to-store %store "builder.sh"
520 "echo one > $out ; echo two > $second"
522 (drv (derivation %store "multiple"
524 #:outputs '("out" "second")))
525 (drv-file (derivation-file-name drv))
526 (one (derivation->output-path drv "out"))
527 (two (derivation->output-path drv "second"))
528 (first (derivation-path->output-path drv-file "out"))
529 (second (derivation-path->output-path drv-file "second")))
530 (and (not (string=? one two))
531 (string-suffix? "-second" two)
533 (string=? second two))))
535 (test-assert "user of multiple-output derivation"
536 ;; Check whether specifying several inputs coming from the same
537 ;; multiple-output derivation works.
538 (let* ((builder1 (add-text-to-store %store "my-mo-builder.sh"
539 "echo one > $out ; echo two > $two"
541 (mdrv (derivation %store "multiple-output"
543 #:sources (list %bash builder1)
544 #:outputs '("out" "two")))
545 (builder2 (add-text-to-store %store "my-mo-user-builder.sh"
548 echo \"($x $y)\" > $out"
550 (udrv (derivation %store "multiple-output-user"
553 . ,(derivation->output-path
556 . ,(derivation->output-path
558 #:sources (list %bash builder2)
559 ;; two occurrences of MDRV:
561 (list (derivation-input mdrv)
562 (derivation-input mdrv '("two"))))))
563 (and (build-derivations %store (list (pk 'udrv udrv)))
564 (let ((p (derivation->output-path udrv)))
565 (and (valid-path? %store p)
566 (equal? '(one two) (call-with-input-file p read)))))))
568 (test-assert "derivation with #:references-graphs"
569 (let* ((input1 (add-text-to-store %store "foo" "hello"
571 (input2 (add-text-to-store %store "bar"
572 (number->string (random 7777))
574 (builder (add-text-to-store %store "build-graph"
577 (while read l ; do echo $l ; done) < bash > $out/bash
578 (while read l ; do echo $l ; done) < input1 > $out/input1
579 (while read l ; do echo $l ; done) < input2 > $out/input2"
582 (drv (derivation %store "closure-graphs"
587 ("input2" . ,input2))
588 #:sources (list %bash builder)))
589 (out (derivation->output-path drv)))
590 (define (deps path . deps)
591 (let ((count (length deps)))
592 (string-append path "\n\n" (number->string count) "\n"
593 (string-join (sort deps string<?) "\n")
594 (if (zero? count) "" "\n"))))
596 (and (build-derivations %store (list drv))
597 (equal? (directory-contents out get-string-all)
598 `(("/bash" . ,(string-append %bash "\n\n0\n"))
599 ("/input1" . ,(if (string>? input1 %bash)
600 (string-append (deps %bash)
602 (string-append (deps input1 %bash)
604 ("/input2" . ,(string-concatenate
608 (cons p (apply deps p d)))
609 (list %bash input1 input2)
610 (list '() (list %bash) (list input1)))
616 (string<? p1 p2)))))))))))))))
618 (test-assert "derivation #:allowed-references, ok"
619 (let ((drv (derivation %store "allowed" %bash
620 '("-c" "echo hello > $out")
621 #:sources (list %bash)
622 #:allowed-references '())))
623 (build-derivations %store (list drv))))
625 (test-assert "derivation #:allowed-references, not allowed"
626 (let* ((txt (add-text-to-store %store "foo" "Hello, world."))
627 (drv (derivation %store "disallowed" %bash
628 `("-c" ,(string-append "echo " txt "> $out"))
629 #:sources (list %bash txt)
630 #:allowed-references '())))
631 (guard (c ((store-protocol-error? c)
632 ;; There's no specific error message to check for.
634 (build-derivations %store (list drv))
637 (test-assert "derivation #:allowed-references, self allowed"
638 (let ((drv (derivation %store "allowed" %bash
639 '("-c" "echo $out > $out")
640 #:sources (list %bash)
641 #:allowed-references '("out"))))
642 (build-derivations %store (list drv))))
644 (test-assert "derivation #:allowed-references, self not allowed"
645 (let ((drv (derivation %store "disallowed" %bash
646 `("-c" ,"echo $out > $out")
647 #:sources (list %bash)
648 #:allowed-references '())))
649 (guard (c ((store-protocol-error? c)
650 ;; There's no specific error message to check for.
652 (build-derivations %store (list drv))
655 (test-assert "derivation #:disallowed-references, ok"
656 (let ((drv (derivation %store "disallowed" %bash
657 '("-c" "echo hello > $out")
658 #:sources (list %bash)
659 #:disallowed-references '("out"))))
660 (build-derivations %store (list drv))))
662 (test-assert "derivation #:disallowed-references, not ok"
663 (let* ((txt (add-text-to-store %store "foo" "Hello, world."))
664 (drv (derivation %store "disdisallowed" %bash
665 `("-c" ,(string-append "echo " txt "> $out"))
666 #:sources (list %bash txt)
667 #:disallowed-references (list txt))))
668 (guard (c ((store-protocol-error? c)
669 ;; There's no specific error message to check for.
671 (build-derivations %store (list drv))
674 ;; Here we should get the value of $GUIX_STATE_DIRECTORY that the daemon sees,
675 ;; which is a unique value for each test process; this value is the same as
676 ;; the one we see in the process executing this file since it is set by
678 (test-equal "derivation #:leaked-env-vars"
679 (getenv "GUIX_STATE_DIRECTORY")
680 (let* ((value (getenv "GUIX_STATE_DIRECTORY"))
681 (drv (derivation %store "leaked-env-vars" %bash
682 '("-c" "echo -n $GUIX_STATE_DIRECTORY > $out")
683 #:hash (gcrypt:sha256 (string->utf8 value))
685 #:sources (list %bash)
686 #:leaked-env-vars '("GUIX_STATE_DIRECTORY"))))
687 (and (build-derivations %store (list drv))
688 (call-with-input-file (derivation->output-path drv)
694 (and (network-reachable?)
695 (package-derivation %store %bootstrap-coreutils&co))))
697 (test-skip (if %coreutils 0 1))
699 (test-assert "build derivation with coreutils"
701 (add-text-to-store %store "build-with-coreutils.sh"
702 "echo $PATH ; mkdir --version ; mkdir $out ; touch $out/good"
705 (derivation %store "foo"
707 #:env-vars `(("PATH" .
709 (derivation->output-path %coreutils)
711 #:sources (list builder)
712 #:inputs (list (derivation-input %coreutils))))
714 (build-derivations %store (list drv))))
716 (let ((p (derivation->output-path drv)))
717 (and (valid-path? %store p)
718 (file-exists? (string-append p "/good")))))))
720 (test-skip (if (%guile-for-build) 0 8))
722 (test-equal "build-expression->derivation and invalid module name"
723 '(file-search-error "guix/module/that/does/not/exist.scm")
724 (guard (c ((file-search-error? c)
725 (list 'file-search-error
726 (file-search-error-file-name c))))
727 (build-expression->derivation %store "foo" #t
728 #:modules '((guix module that
731 (test-equal "build-expression->derivation and builder encoding"
733 (let* ((exp '(λ (α) (+ α 1)))
734 (drv (build-expression->derivation %store "foo" exp)))
735 (match (derivation-builder-arguments drv)
737 (with-fluids ((%default-port-encoding "UTF-8"))
738 (call-with-input-file builder
740 (list (port-encoding port)
742 (string-contains (get-string-all port)
743 "(λ (α) (+ α 1))"))))))))))
745 (test-assert "build-expression->derivation and derivation-prerequisites"
746 (let ((drv (build-expression->derivation %store "fail" #f)))
748 (($ <derivation-input> (= derivation-file-name path))
749 (string=? path (derivation-file-name (%guile-for-build)))))
750 (derivation-prerequisites drv))))
752 (test-assert "derivation-prerequisites and valid-derivation-input?"
753 (let* ((a (build-expression->derivation %store "a" '(mkdir %output)))
754 (b (build-expression->derivation %store "b" `(list ,(random-text))))
755 (c (build-expression->derivation %store "c" `(mkdir %output)
756 #:inputs `(("a" ,a) ("b" ,b)))))
757 ;; Make sure both A and %BOOTSTRAP-GUILE are built (the latter could have
758 ;; be removed by tests/guix-gc.sh.)
759 (build-derivations %store
760 (list a (package-derivation %store %bootstrap-guile)))
762 (match (derivation-prerequisites c
763 (cut valid-derivation-input? %store
765 ((($ <derivation-input> (= derivation-file-name file) ("out")))
766 (string=? file (derivation-file-name b)))
770 (test-assert "build-expression->derivation without inputs"
771 (let* ((builder '(begin
773 (call-with-output-file (string-append %output "/test")
775 (display '(hello guix) p)))))
776 (drv (build-expression->derivation %store "goo" builder))
777 (succeeded? (build-derivations %store (list drv))))
779 (let ((p (derivation->output-path drv)))
780 (equal? '(hello guix)
781 (call-with-input-file (string-append p "/test") read))))))
783 (test-assert "build-expression->derivation and max-silent-time"
784 (let* ((store (let ((s (open-connection)))
785 (set-build-options s #:max-silent-time 1)
787 (builder '(begin (sleep 100) (mkdir %output) #t))
788 (drv (build-expression->derivation store "silent" builder))
789 (out-path (derivation->output-path drv)))
790 (guard (c ((store-protocol-error? c)
791 (and (string-contains (store-protocol-error-message c)
793 (not (valid-path? store out-path)))))
794 (build-derivations store (list drv))
797 (test-assert "build-expression->derivation and timeout"
798 (let* ((store (let ((s (open-connection)))
799 (set-build-options s #:timeout 1)
801 (builder '(begin (sleep 100) (mkdir %output) #t))
802 (drv (build-expression->derivation store "slow" builder))
803 (out-path (derivation->output-path drv)))
804 (guard (c ((store-protocol-error? c)
805 (and (string-contains (store-protocol-error-message c)
807 (not (valid-path? store out-path)))))
808 (build-derivations store (list drv))
811 (test-assert "build-derivations with specific output"
813 (let* ((content (random-text)) ;contents of the output
814 (drv (build-expression->derivation
815 store "substitute-me"
816 `(begin ,content (exit 1)) ;would fail
817 #:outputs '("out" "one" "two")
819 (package-derivation store %bootstrap-guile)))
820 (out (derivation->output-path drv)))
821 (with-derivation-substitute drv content
822 (set-build-options store #:use-substitutes? #t
823 #:substitute-urls (%test-substitute-urls))
824 (and (has-substitutes? store out)
826 ;; Ask for nothing but the "out" output of DRV.
827 (build-derivations store `((,drv . "out")))
830 (build-derivations store (list (derivation-input drv '("out"))))
832 (valid-path? store out)
833 (equal? (pk 'x content)
834 (pk 'y (call-with-input-file out get-string-all))))))))
836 (test-assert "build-expression->derivation and derivation-build-plan"
837 (let ((drv (build-expression->derivation %store "fail" #f)))
838 ;; The only direct dependency is (%guile-for-build) and it's already
840 (null? (derivation-build-plan %store (derivation-inputs drv)))))
842 (test-assert "derivation-build-plan when outputs already present"
843 (let* ((builder `(begin ,(random-text) (mkdir %output) #t))
844 (input-drv (build-expression->derivation %store "input" builder))
845 (input-path (derivation->output-path input-drv))
846 (drv (build-expression->derivation %store "something" builder
848 `(("i" ,input-drv))))
849 (output (derivation->output-path drv)))
850 ;; Assume these things are not already built.
851 (when (or (valid-path? %store input-path)
852 (valid-path? %store output))
853 (error "things already built" input-drv))
856 (map derivation-file-name
857 (derivation-build-plan %store
858 (list (derivation-input drv))))
859 (list (derivation-file-name input-drv)
860 (derivation-file-name drv)))
862 ;; Build DRV and delete its input.
863 (build-derivations %store (list drv))
864 (delete-paths %store (list input-path))
865 (not (valid-path? %store input-path))
867 ;; Now INPUT-PATH is missing, yet it shouldn't be listed as a
868 ;; prerequisite to build because DRV itself is already built.
869 (null? (derivation-build-plan %store
870 (list (derivation-input drv)))))))
872 (test-assert "derivation-build-plan and substitutes"
873 (let* ((store (open-connection))
874 (drv (build-expression->derivation store "prereq-subst"
876 (output (derivation->output-path drv)))
878 ;; Make sure substitutes are usable.
879 (set-build-options store #:use-substitutes? #t
880 #:substitute-urls (%test-substitute-urls))
882 (with-derivation-narinfo drv
883 (let-values (((build download)
884 (derivation-build-plan store
885 (list (derivation-input drv))))
887 (derivation-build-plan store
888 (list (derivation-input drv))
892 (equal? (map substitutable-path download) (list output))
894 (equal? (list drv) build*))))))
896 (test-assert "derivation-build-plan and substitutes, non-substitutable build"
897 (let* ((store (open-connection))
898 (drv (build-expression->derivation store "prereq-no-subst"
900 #:substitutable? #f))
901 (output (derivation->output-path drv)))
903 ;; Make sure substitutes are usable.
904 (set-build-options store #:use-substitutes? #t
905 #:substitute-urls (%test-substitute-urls))
907 (with-derivation-narinfo drv
908 (let-values (((build download)
909 (derivation-build-plan store
910 (list (derivation-input drv)))))
911 ;; Despite being available as a substitute, DRV will be built locally
912 ;; due to #:substitutable? #f.
913 (and (null? download)
915 (((= derivation-file-name build))
916 (string=? build (derivation-file-name drv)))))))))
918 (test-assert "derivation-build-plan and substitutes, non-substitutable dep"
920 (let* ((drv1 (build-expression->derivation store "prereq-no-subst"
922 #:substitutable? #f))
923 (drv2 (build-expression->derivation store "substitutable"
925 #:inputs `(("dep" ,drv1)))))
927 ;; Make sure substitutes are usable.
928 (set-build-options store #:use-substitutes? #t
929 #:substitute-urls (%test-substitute-urls))
931 (with-derivation-narinfo drv2
932 (sha256 => (make-bytevector 32 0))
933 (references => (list (derivation->output-path drv1)))
935 (let-values (((build download)
936 (derivation-build-plan store
937 (list (derivation-input drv2)))))
938 ;; Although DRV2 is available as a substitute, we must build its
939 ;; dependency, DRV1, due to #:substitutable? #f.
941 (((= substitutable-path item))
942 (string=? item (derivation->output-path drv2))))
944 (((= derivation-file-name build))
945 (string=? build (derivation-file-name drv1))))))))))
947 (test-assert "derivation-build-plan and substitutes, local build"
949 (let* ((drv (build-expression->derivation store "prereq-subst-local"
952 (output (derivation->output-path drv)))
954 ;; Make sure substitutes are usable.
955 (set-build-options store #:use-substitutes? #t
956 #:substitute-urls (%test-substitute-urls))
958 (with-derivation-narinfo drv
959 (let-values (((build download)
960 (derivation-build-plan store
961 (list (derivation-input drv)))))
962 ;; #:local-build? is *not* synonymous with #:substitutable?, so we
963 ;; must be able to substitute DRV's output.
964 ;; See <http://bugs.gnu.org/18747>.
967 (((= substitutable-path item))
968 (string=? item (derivation->output-path drv))))))))))
970 (test-assert "derivation-build-plan in 'check' mode"
972 (let* ((dep (build-expression->derivation store "dep"
973 `(begin ,(random-text)
975 (drv (build-expression->derivation store "to-check"
977 #:inputs `(("dep" ,dep)))))
978 (build-derivations store (list drv))
979 (delete-paths store (list (derivation->output-path dep)))
981 ;; In 'check' mode, DEP must be rebuilt.
982 (and (null? (derivation-build-plan store
983 (list (derivation-input drv))))
985 (derivation-build-plan store
986 (list (derivation-input drv))
987 #:mode (build-mode check))
990 (test-assert "derivation-input-fold"
991 (let* ((builder (add-text-to-store %store "my-builder.sh"
992 "echo hello, world > \"$out\"\n"
994 (drv1 (derivation %store "foo"
996 #:sources `(,%bash ,builder)))
997 (drv2 (derivation %store "bar"
1000 #:sources `(,%bash ,builder))))
1001 (equal? (derivation-input-fold (lambda (input result)
1002 (cons (derivation-input-derivation input)
1005 (list (derivation-input drv2)))
1008 (test-assert "substitution-oracle and #:substitute? #f"
1010 (let* ((dep (build-expression->derivation store "dep"
1011 `(begin ,(random-text)
1013 (drv (build-expression->derivation store "not-subst"
1014 `(begin ,(random-text)
1017 #:inputs `(("dep" ,dep))))
1019 (define (record-substitutable-path-query store paths)
1021 (error "already called!" query))
1025 (mock ((guix store) substitutable-path-info
1026 record-substitutable-path-query)
1028 (let ((pred (substitution-oracle store (list drv))))
1029 (pred (derivation->output-path drv))))
1031 ;; Make sure the oracle didn't try to get substitute info for DRV since
1032 ;; DRV is mark as non-substitutable. Assume that GUILE-FOR-BUILD is
1033 ;; already in store and thus not part of QUERY.
1034 (equal? (pk 'query query)
1035 (list (derivation->output-path dep))))))
1037 (test-assert "build-expression->derivation with expression returning #f"
1038 (let* ((builder '(begin
1041 (drv (build-expression->derivation %store "fail" builder))
1042 (out-path (derivation->output-path drv)))
1043 (guard (c ((store-protocol-error? c)
1044 ;; Note that the output path may exist at this point, but it
1046 (and (string-match "build .* failed"
1047 (store-protocol-error-message c))
1048 (not (valid-path? %store out-path)))))
1049 (build-derivations %store (list drv))
1052 (test-assert "build-expression->derivation with two outputs"
1053 (let* ((builder '(begin
1054 (call-with-output-file (assoc-ref %outputs "out")
1056 (display '(hello) p)))
1057 (call-with-output-file (assoc-ref %outputs "second")
1059 (display '(world) p)))))
1060 (drv (build-expression->derivation %store "double" builder
1063 (succeeded? (build-derivations %store (list drv))))
1065 (let ((one (derivation->output-path drv))
1066 (two (derivation->output-path drv "second")))
1067 (and (equal? '(hello) (call-with-input-file one read))
1068 (equal? '(world) (call-with-input-file two read)))))))
1070 (test-skip (if %coreutils 0 1))
1071 (test-assert "build-expression->derivation with one input"
1072 (let* ((builder '(call-with-output-file %output
1074 (let ((cu (assoc-ref %build-inputs "cu")))
1076 (dup2 (port->fdes p) 1)
1077 (execl (string-append cu "/bin/uname")
1079 (drv (build-expression->derivation %store "uname" builder
1081 `(("cu" ,%coreutils))))
1082 (succeeded? (build-derivations %store (list drv))))
1084 (let ((p (derivation->output-path drv)))
1085 (string-contains (call-with-input-file p read-line) "GNU")))))
1087 (test-assert "build-expression->derivation with modules"
1088 (let* ((builder `(begin
1089 (use-modules (guix build utils))
1090 (let ((out (assoc-ref %outputs "out")))
1091 (mkdir-p (string-append out "/guile/guix/nix"))
1093 (drv (build-expression->derivation %store "test-with-modules"
1096 '((guix build utils)))))
1097 (and (build-derivations %store (list drv))
1098 (let* ((p (derivation->output-path drv))
1099 (s (stat (string-append p "/guile/guix/nix"))))
1100 (eq? (stat:type s) 'directory)))))
1102 (test-assert "build-expression->derivation: same fixed-output path"
1103 (let* ((builder1 '(call-with-output-file %output
1105 (write "hello" p))))
1106 (builder2 '(call-with-output-file (pk 'difference-here! %output)
1108 (write "hello" p))))
1109 (hash (gcrypt:sha256 (string->utf8 "hello")))
1110 (input1 (build-expression->derivation %store "fixed" builder1
1112 #:hash-algo 'sha256))
1113 (input2 (build-expression->derivation %store "fixed" builder2
1115 #:hash-algo 'sha256))
1116 (succeeded? (build-derivations %store (list input1 input2))))
1118 (not (string=? (derivation-file-name input1)
1119 (derivation-file-name input2)))
1120 (string=? (derivation->output-path input1)
1121 (derivation->output-path input2)))))
1123 (test-assert "build-expression->derivation with a fixed-output input"
1124 (let* ((builder1 '(call-with-output-file %output
1126 (write "hello" p))))
1127 (builder2 '(call-with-output-file (pk 'difference-here! %output)
1129 (write "hello" p))))
1130 (hash (gcrypt:sha256 (string->utf8 "hello")))
1131 (input1 (build-expression->derivation %store "fixed" builder1
1133 #:hash-algo 'sha256))
1134 (input2 (build-expression->derivation %store "fixed" builder2
1136 #:hash-algo 'sha256))
1137 (builder3 '(let ((input (assoc-ref %build-inputs "input")))
1138 (call-with-output-file %output
1140 (format #f "My input is ~a.~%" input)))))
1141 (final1 (build-expression->derivation %store "final" builder3
1143 `(("input" ,input1))))
1144 (final2 (build-expression->derivation %store "final" builder3
1146 `(("input" ,input2)))))
1147 (and (string=? (derivation->output-path final1)
1148 (derivation->output-path final2))
1149 (string=? (derivation->output-path final1)
1150 (derivation-path->output-path
1151 (derivation-file-name final1)))
1152 (build-derivations %store (list final1 final2)))))
1154 (test-assert "build-expression->derivation produces recursive fixed-output"
1155 (let* ((builder '(begin
1156 (use-modules (srfi srfi-26))
1159 (call-with-output-file "exe"
1160 (cut display "executable" <>))
1162 (symlink "exe" "symlink")
1164 (drv (build-expression->derivation %store "fixed-rec" builder
1167 "10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p")
1169 (and (build-derivations %store (list drv))
1170 (let* ((dir (derivation->output-path drv))
1171 (exe (string-append dir "/exe"))
1172 (link (string-append dir "/symlink"))
1173 (subdir (string-append dir "/subdir")))
1174 (and (executable-file? exe)
1175 (string=? "executable"
1176 (call-with-input-file exe get-string-all))
1177 (string=? "exe" (readlink link))
1178 (file-is-directory? subdir))))))
1180 (test-assert "build-expression->derivation uses recursive fixed-output"
1181 (let* ((builder '(call-with-output-file %output
1183 (display "hello" port))))
1184 (fixed (build-expression->derivation %store "small-fixed-rec"
1188 "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
1190 (in (derivation->output-path fixed))
1194 (symlink ,in "symlink")))
1195 (drv (build-expression->derivation %store "fixed-rec-user"
1197 #:inputs `(("fixed" ,fixed)))))
1198 (and (build-derivations %store (list drv))
1199 (let ((out (derivation->output-path drv)))
1200 (string=? (readlink (string-append out "/symlink")) in)))))
1202 (test-assert "build-expression->derivation with #:references-graphs"
1203 (let* ((input (add-text-to-store %store "foo" "hello"
1204 (list %bash %mkdir)))
1205 (builder '(copy-file "input" %output))
1206 (drv (build-expression->derivation %store "references-graphs"
1209 `(("input" . ,input))))
1210 (out (derivation->output-path drv)))
1211 (define (deps path . deps)
1212 (let ((count (length deps)))
1213 (string-append path "\n\n" (number->string count) "\n"
1214 (string-join (sort deps string<?) "\n")
1215 (if (zero? count) "" "\n"))))
1217 (and (build-derivations %store (list drv))
1218 (equal? (call-with-input-file out get-string-all)
1221 (sort (map (lambda (p d)
1222 (cons p (apply deps p d)))
1223 (list input %bash %mkdir)
1224 (list (list %bash %mkdir)
1231 (string<? p1 p2)))))))))))))
1233 (test-equal "derivation-properties"
1234 (list '() '((type . test)))
1235 (let ((drv1 (build-expression->derivation %store "bar"
1237 (drv2 (build-expression->derivation %store "foo"
1239 #:properties '((type . test)))))
1240 (list (derivation-properties drv1)
1241 (derivation-properties drv2))))
1243 (test-equal "map-derivation"
1245 (let* ((joke (package-derivation %store guile-1.8))
1246 (good (package-derivation %store %bootstrap-guile))
1247 (drv1 (build-expression->derivation %store "original-drv1"
1248 #f ; systematically fail
1249 #:guile-for-build joke))
1250 (drv2 (build-expression->derivation %store "original-drv2"
1251 '(call-with-output-file %output
1253 (display "hello" p)))))
1254 (drv3 (build-expression->derivation %store "drv-to-remap"
1255 '(let ((in (assoc-ref
1256 %build-inputs "in")))
1257 (copy-file in %output))
1258 #:inputs `(("in" ,drv1))
1259 #:guile-for-build joke))
1260 (drv4 (map-derivation %store drv3 `((,drv1 . ,drv2)
1262 (out (derivation->output-path drv4)))
1263 (and (build-derivations %store (list (pk 'remapped drv4)))
1264 (call-with-input-file out get-string-all))))
1266 (test-equal "map-derivation, sources"
1268 (let* ((script1 (add-text-to-store %store "fail.sh" "exit 1"))
1269 (script2 (add-text-to-store %store "hi.sh" "echo -n hello > $out"))
1270 (bash-full (package-derivation %store (@ (gnu packages bash) bash)))
1271 (drv1 (derivation %store "drv-to-remap"
1273 ;; XXX: This wouldn't work in practice, but if
1274 ;; we append "/bin/bash" then we can't replace
1275 ;; it with the bootstrap bash, which is a
1277 (derivation->output-path bash-full)
1280 #:sources (list script1)
1282 (list (derivation-input bash-full '("out")))))
1283 (drv2 (map-derivation %store drv1
1284 `((,bash-full . ,%bash)
1285 (,script1 . ,script2))))
1286 (out (derivation->output-path drv2)))
1287 (and (build-derivations %store (list (pk 'remapped* drv2)))
1288 (call-with-input-file out get-string-all))))
1293 ;; eval: (put 'with-http-server 'scheme-indent-function 1)