1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2012, 2013, 2014, 2015, 2016 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 (define-module (test-derivations)
20 #:use-module (guix derivations)
21 #:use-module (guix store)
22 #:use-module (guix utils)
23 #:use-module (guix hash)
24 #:use-module (guix base32)
25 #:use-module (guix tests)
26 #:use-module ((guix packages) #:select (package-derivation base32))
27 #:use-module ((guix build utils) #:select (executable-file?))
28 #:use-module ((gnu packages) #:select (search-bootstrap-binary))
29 #:use-module (gnu packages bootstrap)
30 #:use-module ((gnu packages guile) #:select (guile-1.8))
31 #:use-module (srfi srfi-1)
32 #:use-module (srfi srfi-11)
33 #:use-module (srfi srfi-26)
34 #:use-module (srfi srfi-34)
35 #:use-module (srfi srfi-64)
36 #:use-module (rnrs io ports)
37 #:use-module (rnrs bytevectors)
38 #:use-module (web uri)
39 #:use-module (ice-9 rdelim)
40 #:use-module (ice-9 regex)
41 #:use-module (ice-9 ftw)
42 #:use-module (ice-9 match))
45 (open-connection-for-tests))
47 (define (bootstrap-binary name)
48 (let ((bin (search-bootstrap-binary name (%current-system))))
50 (add-to-store %store name #t "sha256" bin))))
53 (bootstrap-binary "bash"))
55 (bootstrap-binary "mkdir"))
57 (define* (directory-contents dir #:optional (slurp get-bytevector-all))
58 "Return an alist representing the contents of DIR."
59 (define prefix-len (string-length dir))
60 (sort (file-system-fold (const #t) ; enter?
61 (lambda (path stat result) ; leaf
62 (alist-cons (string-drop path prefix-len)
63 (call-with-input-file path slurp)
65 (lambda (path stat result) result) ; down
66 (lambda (path stat result) result) ; up
67 (lambda (path stat result) result) ; skip
68 (lambda (path stat errno result) result) ; error
72 (string<? (car e1) (car e2)))))
74 (test-begin "derivations")
76 (test-assert "parse & export"
77 (let* ((f (search-path %load-path "tests/test.drv"))
78 (b1 (call-with-input-file f get-bytevector-all))
79 (d1 (read-derivation (open-bytevector-input-port b1)))
80 (b2 (call-with-bytevector-output-port (cut write-derivation d1 <>)))
81 (d2 (read-derivation (open-bytevector-input-port b2))))
85 (test-skip (if %store 0 12))
87 (test-assert "add-to-store, flat"
88 (let* ((file (search-path %load-path "language/tree-il/spec.scm"))
89 (drv (add-to-store %store "flat-test" #f "sha256" file)))
90 (and (eq? 'regular (stat:type (stat drv)))
91 (valid-path? %store drv)
92 (equal? (call-with-input-file file get-bytevector-all)
93 (call-with-input-file drv get-bytevector-all)))))
95 (test-assert "add-to-store, recursive"
96 (let* ((dir (dirname (search-path %load-path "language/tree-il/spec.scm")))
97 (drv (add-to-store %store "dir-tree-test" #t "sha256" dir)))
98 (and (eq? 'directory (stat:type (stat drv)))
99 (valid-path? %store drv)
100 (equal? (directory-contents dir)
101 (directory-contents drv)))))
103 (test-assert "derivation with no inputs"
104 (let* ((builder (add-text-to-store %store "my-builder.sh"
105 "echo hello, world\n"
107 (drv (derivation %store "foo"
108 %bash `("-e" ,builder)
109 #:env-vars '(("HOME" . "/homeless")))))
110 (and (store-path? (derivation-file-name drv))
111 (valid-path? %store (derivation-file-name drv)))))
113 (test-assert "build derivation with 1 source"
114 (let* ((builder (add-text-to-store %store "my-builder.sh"
115 "echo hello, world > \"$out\"\n"
117 (drv (derivation %store "foo"
119 #:env-vars '(("HOME" . "/homeless")
122 #:inputs `((,%bash) (,builder))))
124 (build-derivations %store (list drv))))
126 (let ((path (derivation->output-path drv)))
127 (and (valid-path? %store path)
128 (string=? (call-with-input-file path read-line)
131 (test-assert "derivation with local file as input"
132 (let* ((builder (add-text-to-store
133 %store "my-builder.sh"
134 "(while read line ; do echo \"$line\" ; done) < $in > $out"
136 (input (search-path %load-path "ice-9/boot-9.scm"))
137 (input* (add-to-store %store (basename input)
139 (drv (derivation %store "derivation-with-input-file"
142 ;; Cheat to pass the actual file name to the
144 #:env-vars `(("in" . ,input*))
148 (,input))))) ; ← local file name
149 (and (build-derivations %store (list drv))
150 ;; Note: we can't compare the files because the above trick alters
152 (valid-path? %store (derivation->output-path drv)))))
154 (test-assert "derivation fails but keep going"
155 ;; In keep-going mode, 'build-derivations' should fail because of D1, but it
156 ;; must return only after D2 has succeeded.
158 (let* ((d1 (derivation %store "fails"
159 %bash `("-c" "false")
160 #:inputs `((,%bash))))
161 (d2 (build-expression->derivation %store "sleep-then-succeed"
164 ;; XXX: Hopefully that's long
165 ;; enough that D1 has already
169 (set-build-options %store
170 #:use-substitutes? #f
172 (guard (c ((nix-protocol-error? c)
173 (and (= 100 (nix-protocol-error-status c))
174 (string-contains (nix-protocol-error-message c)
175 (derivation-file-name d1))
176 (not (valid-path? %store (derivation->output-path d1)))
177 (valid-path? %store (derivation->output-path d2)))))
178 (build-derivations %store (list d1 d2))
181 (test-assert "identical files are deduplicated"
182 (let* ((build1 (add-text-to-store %store "one.sh"
183 "echo hello, world > \"$out\"\n"
185 (build2 (add-text-to-store %store "two.sh"
186 "# Hey!\necho hello, world > \"$out\"\n"
188 (drv1 (derivation %store "foo"
190 #:inputs `((,%bash) (,build1))))
191 (drv2 (derivation %store "bar"
193 #:inputs `((,%bash) (,build2)))))
194 (and (build-derivations %store (list drv1 drv2))
195 (let ((file1 (derivation->output-path drv1))
196 (file2 (derivation->output-path drv2)))
197 (and (valid-path? %store file1) (valid-path? %store file2)
198 (string=? (call-with-input-file file1 get-string-all)
200 (= (stat:ino (lstat file1))
201 (stat:ino (lstat file2))))))))
203 (test-equal "derivation-name"
205 (let ((drv (derivation %store "foo-0.0" %bash '())))
206 (derivation-name drv)))
208 (test-equal "derivation-output-names"
209 '(("out") ("bar" "chbouib"))
210 (let ((drv1 (derivation %store "foo-0.0" %bash '()))
211 (drv2 (derivation %store "foo-0.0" %bash '()
212 #:outputs '("bar" "chbouib"))))
213 (list (derivation-output-names drv1)
214 (derivation-output-names drv2))))
216 (test-assert "offloadable-derivation?"
217 (and (offloadable-derivation? (derivation %store "foo" %bash '()))
218 (offloadable-derivation? ;see <http://bugs.gnu.org/18747>
219 (derivation %store "foo" %bash '()
220 #:substitutable? #f))
221 (not (offloadable-derivation?
222 (derivation %store "foo" %bash '()
223 #:local-build? #t)))))
225 (test-assert "substitutable-derivation?"
226 (and (substitutable-derivation? (derivation %store "foo" %bash '()))
227 (substitutable-derivation? ;see <http://bugs.gnu.org/18747>
228 (derivation %store "foo" %bash '()
230 (not (substitutable-derivation?
231 (derivation %store "foo" %bash '()
232 #:substitutable? #f)))))
234 (test-assert "fixed-output-derivation?"
235 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
236 "echo -n hello > $out" '()))
237 (hash (sha256 (string->utf8 "hello")))
238 (drv (derivation %store "fixed"
240 #:inputs `((,builder))
241 #:hash hash #:hash-algo 'sha256)))
242 (fixed-output-derivation? drv)))
244 (test-assert "fixed-output derivation"
245 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
246 "echo -n hello > $out" '()))
247 (hash (sha256 (string->utf8 "hello")))
248 (drv (derivation %store "fixed"
250 #:inputs `((,builder)) ; optional
251 #:hash hash #:hash-algo 'sha256))
252 (succeeded? (build-derivations %store (list drv))))
254 (let ((p (derivation->output-path drv)))
255 (and (equal? (string->utf8 "hello")
256 (call-with-input-file p get-bytevector-all))
257 (bytevector? (query-path-hash %store p)))))))
259 (test-assert "fixed-output derivation: output paths are equal"
260 (let* ((builder1 (add-text-to-store %store "fixed-builder1.sh"
261 "echo -n hello > $out" '()))
262 (builder2 (add-text-to-store %store "fixed-builder2.sh"
263 "echo hey; echo -n hello > $out" '()))
264 (hash (sha256 (string->utf8 "hello")))
265 (drv1 (derivation %store "fixed"
267 #:hash hash #:hash-algo 'sha256))
268 (drv2 (derivation %store "fixed"
270 #:hash hash #:hash-algo 'sha256))
271 (succeeded? (build-derivations %store (list drv1 drv2))))
273 (equal? (derivation->output-path drv1)
274 (derivation->output-path drv2)))))
276 (test-assert "fixed-output derivation, recursive"
277 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
278 "echo -n hello > $out" '()))
279 (hash (sha256 (string->utf8 "hello")))
280 (drv (derivation %store "fixed-rec"
282 #:inputs `((,builder))
283 #:hash (base32 "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
286 (succeeded? (build-derivations %store (list drv))))
288 (let ((p (derivation->output-path drv)))
289 (and (equal? (string->utf8 "hello")
290 (call-with-input-file p get-bytevector-all))
291 (bytevector? (query-path-hash %store p)))))))
293 (test-assert "derivation with a fixed-output input"
294 ;; A derivation D using a fixed-output derivation F doesn't has the same
295 ;; output path when passed F or F', as long as F and F' have the same output
297 (let* ((builder1 (add-text-to-store %store "fixed-builder1.sh"
298 "echo -n hello > $out" '()))
299 (builder2 (add-text-to-store %store "fixed-builder2.sh"
300 "echo hey; echo -n hello > $out" '()))
301 (hash (sha256 (string->utf8 "hello")))
302 (fixed1 (derivation %store "fixed"
304 #:hash hash #:hash-algo 'sha256))
305 (fixed2 (derivation %store "fixed"
307 #:hash hash #:hash-algo 'sha256))
308 (fixed-out (derivation->output-path fixed1))
309 (builder3 (add-text-to-store
310 %store "final-builder.sh"
311 ;; Use Bash hackery to avoid Coreutils.
312 "echo $in ; (read -u 3 c; echo $c) 3< $in > $out" '()))
313 (final1 (derivation %store "final"
315 #:env-vars `(("in" . ,fixed-out))
316 #:inputs `((,%bash) (,builder3) (,fixed1))))
317 (final2 (derivation %store "final"
319 #:env-vars `(("in" . ,fixed-out))
320 #:inputs `((,%bash) (,builder3) (,fixed2))))
321 (succeeded? (build-derivations %store
322 (list final1 final2))))
324 (equal? (derivation->output-path final1)
325 (derivation->output-path final2)))))
327 (test-assert "multiple-output derivation"
328 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
329 "echo one > $out ; echo two > $second"
331 (drv (derivation %store "fixed"
333 #:env-vars '(("HOME" . "/homeless")
336 #:inputs `((,%bash) (,builder))
337 #:outputs '("out" "second")))
338 (succeeded? (build-derivations %store (list drv))))
340 (let ((one (derivation->output-path drv "out"))
341 (two (derivation->output-path drv "second")))
343 (derivation->output-paths drv)
344 `(("out" . ,one) ("second" . ,two)))
345 (eq? 'one (call-with-input-file one read))
346 (eq? 'two (call-with-input-file two read)))))))
348 (test-assert "multiple-output derivation, non-alphabetic order"
349 ;; Here, the outputs are not listed in alphabetic order. Yet, the store
350 ;; path computation must reorder them first.
351 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
352 "echo one > $out ; echo two > $AAA"
354 (drv (derivation %store "fixed"
356 #:inputs `((,%bash) (,builder))
357 #:outputs '("out" "AAA")))
358 (succeeded? (build-derivations %store (list drv))))
360 (let ((one (derivation->output-path drv "out"))
361 (two (derivation->output-path drv "AAA")))
362 (and (eq? 'one (call-with-input-file one read))
363 (eq? 'two (call-with-input-file two read)))))))
365 (test-assert "multiple-output derivation, derivation-path->output-path"
366 (let* ((builder (add-text-to-store %store "builder.sh"
367 "echo one > $out ; echo two > $second"
369 (drv (derivation %store "multiple"
371 #:outputs '("out" "second")))
372 (drv-file (derivation-file-name drv))
373 (one (derivation->output-path drv "out"))
374 (two (derivation->output-path drv "second"))
375 (first (derivation-path->output-path drv-file "out"))
376 (second (derivation-path->output-path drv-file "second")))
377 (and (not (string=? one two))
378 (string-suffix? "-second" two)
380 (string=? second two))))
382 (test-assert "user of multiple-output derivation"
383 ;; Check whether specifying several inputs coming from the same
384 ;; multiple-output derivation works.
385 (let* ((builder1 (add-text-to-store %store "my-mo-builder.sh"
386 "echo one > $out ; echo two > $two"
388 (mdrv (derivation %store "multiple-output"
390 #:inputs `((,%bash) (,builder1))
391 #:outputs '("out" "two")))
392 (builder2 (add-text-to-store %store "my-mo-user-builder.sh"
395 echo \"($x $y)\" > $out"
397 (udrv (derivation %store "multiple-output-user"
400 . ,(derivation->output-path
403 . ,(derivation->output-path
407 ;; two occurrences of MDRV:
410 (and (build-derivations %store (list (pk 'udrv udrv)))
411 (let ((p (derivation->output-path udrv)))
412 (and (valid-path? %store p)
413 (equal? '(one two) (call-with-input-file p read)))))))
415 (test-assert "derivation with #:references-graphs"
416 (let* ((input1 (add-text-to-store %store "foo" "hello"
418 (input2 (add-text-to-store %store "bar"
419 (number->string (random 7777))
421 (builder (add-text-to-store %store "build-graph"
424 (while read l ; do echo $l ; done) < bash > $out/bash
425 (while read l ; do echo $l ; done) < input1 > $out/input1
426 (while read l ; do echo $l ; done) < input2 > $out/input2"
429 (drv (derivation %store "closure-graphs"
434 ("input2" . ,input2))
435 #:inputs `((,%bash) (,builder))))
436 (out (derivation->output-path drv)))
437 (define (deps path . deps)
438 (let ((count (length deps)))
439 (string-append path "\n\n" (number->string count) "\n"
440 (string-join (sort deps string<?) "\n")
441 (if (zero? count) "" "\n"))))
443 (and (build-derivations %store (list drv))
444 (equal? (directory-contents out get-string-all)
445 `(("/bash" . ,(string-append %bash "\n\n0\n"))
446 ("/input1" . ,(if (string>? input1 %bash)
447 (string-append (deps %bash)
449 (string-append (deps input1 %bash)
451 ("/input2" . ,(string-concatenate
455 (cons p (apply deps p d)))
456 (list %bash input1 input2)
457 (list '() (list %bash) (list input1)))
463 (string<? p1 p2)))))))))))))))
465 (test-assert "derivation #:allowed-references, ok"
466 (let ((drv (derivation %store "allowed" %bash
467 '("-c" "echo hello > $out")
469 #:allowed-references '())))
470 (build-derivations %store (list drv))))
472 (test-assert "derivation #:allowed-references, not allowed"
473 (let* ((txt (add-text-to-store %store "foo" "Hello, world."))
474 (drv (derivation %store "disallowed" %bash
475 `("-c" ,(string-append "echo " txt "> $out"))
476 #:inputs `((,%bash) (,txt))
477 #:allowed-references '())))
478 (guard (c ((nix-protocol-error? c)
479 ;; There's no specific error message to check for.
481 (build-derivations %store (list drv))
484 (test-assert "derivation #:allowed-references, self allowed"
485 (let ((drv (derivation %store "allowed" %bash
486 '("-c" "echo $out > $out")
488 #:allowed-references '("out"))))
489 (build-derivations %store (list drv))))
491 (test-assert "derivation #:allowed-references, self not allowed"
492 (let ((drv (derivation %store "disallowed" %bash
493 `("-c" ,"echo $out > $out")
495 #:allowed-references '())))
496 (guard (c ((nix-protocol-error? c)
497 ;; There's no specific error message to check for.
499 (build-derivations %store (list drv))
502 ;; Here we should get the value of $NIX_STATE_DIR that the daemon sees, which
503 ;; is a unique value for each test process; this value is the same as the one
504 ;; we see in the process executing this file since it is set by 'test-env'.
505 (test-equal "derivation #:leaked-env-vars"
506 (getenv "NIX_STATE_DIR")
507 (let* ((value (getenv "NIX_STATE_DIR"))
508 (drv (derivation %store "leaked-env-vars" %bash
509 '("-c" "echo -n $NIX_STATE_DIR > $out")
510 #:hash (sha256 (string->utf8 value))
513 #:leaked-env-vars '("NIX_STATE_DIR"))))
514 (and (build-derivations %store (list drv))
515 (call-with-input-file (derivation->output-path drv)
521 (and (network-reachable?)
522 (package-derivation %store %bootstrap-coreutils&co))))
524 (test-skip (if %coreutils 0 1))
526 (test-assert "build derivation with coreutils"
528 (add-text-to-store %store "build-with-coreutils.sh"
529 "echo $PATH ; mkdir --version ; mkdir $out ; touch $out/good"
532 (derivation %store "foo"
534 #:env-vars `(("PATH" .
536 (derivation->output-path %coreutils)
538 #:inputs `((,builder)
541 (build-derivations %store (list drv))))
543 (let ((p (derivation->output-path drv)))
544 (and (valid-path? %store p)
545 (file-exists? (string-append p "/good")))))))
547 (test-skip (if (%guile-for-build) 0 8))
549 (test-assert "build-expression->derivation and derivation-prerequisites"
550 (let ((drv (build-expression->derivation %store "fail" #f)))
552 (($ <derivation-input> path)
553 (string=? path (derivation-file-name (%guile-for-build)))))
554 (derivation-prerequisites drv))))
556 (test-assert "derivation-prerequisites and valid-derivation-input?"
557 (let* ((a (build-expression->derivation %store "a" '(mkdir %output)))
558 (b (build-expression->derivation %store "b" `(list ,(random-text))))
559 (c (build-expression->derivation %store "c" `(mkdir %output)
560 #:inputs `(("a" ,a) ("b" ,b)))))
561 ;; Make sure both A and %BOOTSTRAP-GUILE are built (the latter could have
562 ;; be removed by tests/guix-gc.sh.)
563 (build-derivations %store
564 (list a (package-derivation %store %bootstrap-guile)))
566 (match (derivation-prerequisites c
567 (cut valid-derivation-input? %store
569 ((($ <derivation-input> file ("out")))
570 (string=? file (derivation-file-name b)))
574 (test-assert "build-expression->derivation without inputs"
575 (let* ((builder '(begin
577 (call-with-output-file (string-append %output "/test")
579 (display '(hello guix) p)))))
580 (drv (build-expression->derivation %store "goo" builder))
581 (succeeded? (build-derivations %store (list drv))))
583 (let ((p (derivation->output-path drv)))
584 (equal? '(hello guix)
585 (call-with-input-file (string-append p "/test") read))))))
587 (test-assert "build-expression->derivation and max-silent-time"
588 (let* ((store (let ((s (open-connection)))
589 (set-build-options s #:max-silent-time 1)
591 (builder '(begin (sleep 100) (mkdir %output) #t))
592 (drv (build-expression->derivation store "silent" builder))
593 (out-path (derivation->output-path drv)))
594 (guard (c ((nix-protocol-error? c)
595 (and (string-contains (nix-protocol-error-message c)
597 (not (valid-path? store out-path)))))
598 (build-derivations store (list drv))
601 (test-assert "build-expression->derivation and timeout"
602 (let* ((store (let ((s (open-connection)))
603 (set-build-options s #:timeout 1)
605 (builder '(begin (sleep 100) (mkdir %output) #t))
606 (drv (build-expression->derivation store "slow" builder))
607 (out-path (derivation->output-path drv)))
608 (guard (c ((nix-protocol-error? c)
609 (and (string-contains (nix-protocol-error-message c)
611 (not (valid-path? store out-path)))))
612 (build-derivations store (list drv))
615 (test-assert "build-expression->derivation and derivation-prerequisites-to-build"
616 (let ((drv (build-expression->derivation %store "fail" #f)))
617 ;; The only direct dependency is (%guile-for-build) and it's already
619 (null? (derivation-prerequisites-to-build %store drv))))
621 (test-assert "derivation-prerequisites-to-build when outputs already present"
622 (let* ((builder '(begin (mkdir %output) #t))
623 (input-drv (build-expression->derivation %store "input" builder))
624 (input-path (derivation-output-path
625 (assoc-ref (derivation-outputs input-drv)
627 (drv (build-expression->derivation %store "something" builder
629 `(("i" ,input-drv))))
630 (output (derivation->output-path drv)))
631 ;; Make sure these things are not already built.
632 (when (valid-path? %store input-path)
633 (delete-paths %store (list input-path)))
634 (when (valid-path? %store output)
635 (delete-paths %store (list output)))
637 (and (equal? (map derivation-input-path
638 (derivation-prerequisites-to-build %store drv))
639 (list (derivation-file-name input-drv)))
641 ;; Build DRV and delete its input.
642 (build-derivations %store (list drv))
643 (delete-paths %store (list input-path))
644 (not (valid-path? %store input-path))
646 ;; Now INPUT-PATH is missing, yet it shouldn't be listed as a
647 ;; prerequisite to build because DRV itself is already built.
648 (null? (derivation-prerequisites-to-build %store drv)))))
650 (test-assert "derivation-prerequisites-to-build and substitutes"
651 (let* ((store (open-connection))
652 (drv (build-expression->derivation store "prereq-subst"
654 (output (derivation->output-path drv)))
656 ;; Make sure substitutes are usable.
657 (set-build-options store #:use-substitutes? #t
658 #:substitute-urls (%test-substitute-urls))
660 (with-derivation-narinfo drv
661 (let-values (((build download)
662 (derivation-prerequisites-to-build store drv))
664 (derivation-prerequisites-to-build store drv
668 (equal? download (list output))
672 (test-assert "derivation-prerequisites-to-build and substitutes, non-substitutable build"
673 (let* ((store (open-connection))
674 (drv (build-expression->derivation store "prereq-no-subst"
676 #:substitutable? #f))
677 (output (derivation->output-path drv)))
679 ;; Make sure substitutes are usable.
680 (set-build-options store #:use-substitutes? #t
681 #:substitute-urls (%test-substitute-urls))
683 (with-derivation-narinfo drv
684 (let-values (((build download)
685 (derivation-prerequisites-to-build store drv)))
686 ;; Despite being available as a substitute, DRV will be built locally
687 ;; due to #:substitutable? #f.
688 (and (null? download)
690 (((? derivation-input? input))
691 (string=? (derivation-input-path input)
692 (derivation-file-name drv)))))))))
694 (test-assert "derivation-prerequisites-to-build and substitutes, local build"
696 (let* ((drv (build-expression->derivation store "prereq-subst-local"
699 (output (derivation->output-path drv)))
701 ;; Make sure substitutes are usable.
702 (set-build-options store #:use-substitutes? #t
703 #:substitute-urls (%test-substitute-urls))
705 (with-derivation-narinfo drv
706 (let-values (((build download)
707 (derivation-prerequisites-to-build store drv)))
708 ;; #:local-build? is *not* synonymous with #:substitutable?, so we
709 ;; must be able to substitute DRV's output.
710 ;; See <http://bugs.gnu.org/18747>.
714 (string=? item (derivation->output-path drv))))))))))
716 (test-assert "derivation-prerequisites-to-build in 'check' mode"
718 (let* ((dep (build-expression->derivation store "dep"
719 `(begin ,(random-text)
721 (drv (build-expression->derivation store "to-check"
723 #:inputs `(("dep" ,dep)))))
724 (build-derivations store (list drv))
725 (delete-paths store (list (derivation->output-path dep)))
727 ;; In 'check' mode, DEP must be rebuilt.
728 (and (null? (derivation-prerequisites-to-build store drv))
729 (match (derivation-prerequisites-to-build store drv
733 (string=? (derivation-input-path input)
734 (derivation-file-name dep))))))))
736 (test-assert "build-expression->derivation with expression returning #f"
737 (let* ((builder '(begin
740 (drv (build-expression->derivation %store "fail" builder))
741 (out-path (derivation->output-path drv)))
742 (guard (c ((nix-protocol-error? c)
743 ;; Note that the output path may exist at this point, but it
745 (and (string-match "build .* failed"
746 (nix-protocol-error-message c))
747 (not (valid-path? %store out-path)))))
748 (build-derivations %store (list drv))
751 (test-assert "build-expression->derivation with two outputs"
752 (let* ((builder '(begin
753 (call-with-output-file (assoc-ref %outputs "out")
755 (display '(hello) p)))
756 (call-with-output-file (assoc-ref %outputs "second")
758 (display '(world) p)))))
759 (drv (build-expression->derivation %store "double" builder
762 (succeeded? (build-derivations %store (list drv))))
764 (let ((one (derivation->output-path drv))
765 (two (derivation->output-path drv "second")))
766 (and (equal? '(hello) (call-with-input-file one read))
767 (equal? '(world) (call-with-input-file two read)))))))
769 (test-skip (if %coreutils 0 1))
770 (test-assert "build-expression->derivation with one input"
771 (let* ((builder '(call-with-output-file %output
773 (let ((cu (assoc-ref %build-inputs "cu")))
775 (dup2 (port->fdes p) 1)
776 (execl (string-append cu "/bin/uname")
778 (drv (build-expression->derivation %store "uname" builder
780 `(("cu" ,%coreutils))))
781 (succeeded? (build-derivations %store (list drv))))
783 (let ((p (derivation->output-path drv)))
784 (string-contains (call-with-input-file p read-line) "GNU")))))
786 (test-assert "build-expression->derivation with modules"
787 (let* ((builder `(begin
788 (use-modules (guix build utils))
789 (let ((out (assoc-ref %outputs "out")))
790 (mkdir-p (string-append out "/guile/guix/nix"))
792 (drv (build-expression->derivation %store "test-with-modules"
795 '((guix build utils)))))
796 (and (build-derivations %store (list drv))
797 (let* ((p (derivation->output-path drv))
798 (s (stat (string-append p "/guile/guix/nix"))))
799 (eq? (stat:type s) 'directory)))))
801 (test-assert "build-expression->derivation: same fixed-output path"
802 (let* ((builder1 '(call-with-output-file %output
805 (builder2 '(call-with-output-file (pk 'difference-here! %output)
808 (hash (sha256 (string->utf8 "hello")))
809 (input1 (build-expression->derivation %store "fixed" builder1
811 #:hash-algo 'sha256))
812 (input2 (build-expression->derivation %store "fixed" builder2
814 #:hash-algo 'sha256))
815 (succeeded? (build-derivations %store (list input1 input2))))
817 (not (string=? (derivation-file-name input1)
818 (derivation-file-name input2)))
819 (string=? (derivation->output-path input1)
820 (derivation->output-path input2)))))
822 (test-assert "build-expression->derivation with a fixed-output input"
823 (let* ((builder1 '(call-with-output-file %output
826 (builder2 '(call-with-output-file (pk 'difference-here! %output)
829 (hash (sha256 (string->utf8 "hello")))
830 (input1 (build-expression->derivation %store "fixed" builder1
832 #:hash-algo 'sha256))
833 (input2 (build-expression->derivation %store "fixed" builder2
835 #:hash-algo 'sha256))
836 (builder3 '(let ((input (assoc-ref %build-inputs "input")))
837 (call-with-output-file %output
839 (format #f "My input is ~a.~%" input)))))
840 (final1 (build-expression->derivation %store "final" builder3
842 `(("input" ,input1))))
843 (final2 (build-expression->derivation %store "final" builder3
845 `(("input" ,input2)))))
846 (and (string=? (derivation->output-path final1)
847 (derivation->output-path final2))
848 (string=? (derivation->output-path final1)
849 (derivation-path->output-path
850 (derivation-file-name final1)))
851 (build-derivations %store (list final1 final2)))))
853 (test-assert "build-expression->derivation produces recursive fixed-output"
854 (let* ((builder '(begin
855 (use-modules (srfi srfi-26))
858 (call-with-output-file "exe"
859 (cut display "executable" <>))
861 (symlink "exe" "symlink")
863 (drv (build-expression->derivation %store "fixed-rec" builder
866 "10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p")
868 (and (build-derivations %store (list drv))
869 (let* ((dir (derivation->output-path drv))
870 (exe (string-append dir "/exe"))
871 (link (string-append dir "/symlink"))
872 (subdir (string-append dir "/subdir")))
873 (and (executable-file? exe)
874 (string=? "executable"
875 (call-with-input-file exe get-string-all))
876 (string=? "exe" (readlink link))
877 (file-is-directory? subdir))))))
879 (test-assert "build-expression->derivation uses recursive fixed-output"
880 (let* ((builder '(call-with-output-file %output
882 (display "hello" port))))
883 (fixed (build-expression->derivation %store "small-fixed-rec"
887 "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
889 (in (derivation->output-path fixed))
893 (symlink ,in "symlink")))
894 (drv (build-expression->derivation %store "fixed-rec-user"
896 #:inputs `(("fixed" ,fixed)))))
897 (and (build-derivations %store (list drv))
898 (let ((out (derivation->output-path drv)))
899 (string=? (readlink (string-append out "/symlink")) in)))))
901 (test-assert "build-expression->derivation with #:references-graphs"
902 (let* ((input (add-text-to-store %store "foo" "hello"
903 (list %bash %mkdir)))
904 (builder '(copy-file "input" %output))
905 (drv (build-expression->derivation %store "references-graphs"
908 `(("input" . ,input))))
909 (out (derivation->output-path drv)))
910 (define (deps path . deps)
911 (let ((count (length deps)))
912 (string-append path "\n\n" (number->string count) "\n"
913 (string-join (sort deps string<?) "\n")
914 (if (zero? count) "" "\n"))))
916 (and (build-derivations %store (list drv))
917 (equal? (call-with-input-file out get-string-all)
920 (sort (map (lambda (p d)
921 (cons p (apply deps p d)))
922 (list input %bash %mkdir)
923 (list (list %bash %mkdir)
930 (string<? p1 p2)))))))))))))
933 (test-assert "graft-derivation"
934 (let* ((build `(begin
937 (symlink %output "self")
938 (call-with-output-file "text"
940 (format output "foo/~a/bar" ,%mkdir)))
941 (symlink ,%bash "sh")))
942 (orig (build-expression->derivation %store "graft" build
943 #:inputs `(("a" ,%bash)
945 (one (add-text-to-store %store "bash" "fake bash"))
946 (two (build-expression->derivation %store "mkdir"
947 '(call-with-output-file %output
949 (display "fake mkdir" port)))))
950 (graft (graft-derivation %store "graft" orig
956 (replacement two))))))
957 (and (build-derivations %store (list graft))
958 (let ((two (derivation->output-path two))
959 (graft (derivation->output-path graft)))
960 (and (string=? (format #f "foo/~a/bar" two)
961 (call-with-input-file (string-append graft "/text")
963 (string=? (readlink (string-append graft "/sh")) one)
964 (string=? (readlink (string-append graft "/self")) graft))))))
966 (test-equal "map-derivation"
968 (let* ((joke (package-derivation %store guile-1.8))
969 (good (package-derivation %store %bootstrap-guile))
970 (drv1 (build-expression->derivation %store "original-drv1"
971 #f ; systematically fail
972 #:guile-for-build joke))
973 (drv2 (build-expression->derivation %store "original-drv2"
974 '(call-with-output-file %output
976 (display "hello" p)))))
977 (drv3 (build-expression->derivation %store "drv-to-remap"
978 '(let ((in (assoc-ref
979 %build-inputs "in")))
980 (copy-file in %output))
981 #:inputs `(("in" ,drv1))
982 #:guile-for-build joke))
983 (drv4 (map-derivation %store drv3 `((,drv1 . ,drv2)
985 (out (derivation->output-path drv4)))
986 (and (build-derivations %store (list (pk 'remapped drv4)))
987 (call-with-input-file out get-string-all))))
989 (test-equal "map-derivation, sources"
991 (let* ((script1 (add-text-to-store %store "fail.sh" "exit 1"))
992 (script2 (add-text-to-store %store "hi.sh" "echo -n hello > $out"))
993 (bash-full (package-derivation %store (@ (gnu packages bash) bash)))
994 (drv1 (derivation %store "drv-to-remap"
996 ;; XXX: This wouldn't work in practice, but if
997 ;; we append "/bin/bash" then we can't replace
998 ;; it with the bootstrap bash, which is a
1000 (derivation->output-path bash-full)
1003 #:inputs `((,bash-full) (,script1))))
1004 (drv2 (map-derivation %store drv1
1005 `((,bash-full . ,%bash)
1006 (,script1 . ,script2))))
1007 (out (derivation->output-path drv2)))
1008 (and (build-derivations %store (list (pk 'remapped* drv2)))
1009 (call-with-input-file out get-string-all))))
1014 (exit (= (test-runner-fail-count (test-runner-current)) 0))