derivations: 'map-derivation' uses the new 'derivation' calling convention.
[jackhill/guix/guix.git] / tests / derivations.scm
CommitLineData
233e7676 1;;; GNU Guix --- Functional package management for GNU
f9e8a123 2;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
341c6fdd 3;;;
233e7676 4;;; This file is part of GNU Guix.
341c6fdd 5;;;
233e7676 6;;; GNU Guix is free software; you can redistribute it and/or modify it
341c6fdd
LC
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.
10;;;
233e7676 11;;; GNU Guix is distributed in the hope that it will be useful, but
341c6fdd
LC
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.
15;;;
16;;; You should have received a copy of the GNU General Public License
233e7676 17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
341c6fdd 18
94d92c77
LC
19(unsetenv "http_proxy")
20
341c6fdd
LC
21(define-module (test-derivations)
22 #:use-module (guix derivations)
ef8de985 23 #:use-module (guix grafts)
26bbbb95 24 #:use-module (guix store)
de4c3f26 25 #:use-module (guix utils)
ca719424 26 #:use-module (gcrypt hash)
ddc29a78 27 #:use-module (guix base32)
c1bc358f 28 #:use-module (guix tests)
94d92c77 29 #:use-module (guix tests http)
36bbbbd1
LC
30 #:use-module ((guix packages) #:select (package-derivation base32))
31 #:use-module ((guix build utils) #:select (executable-file?))
59a43334 32 #:use-module ((gnu packages) #:select (search-bootstrap-binary))
1ffa7090 33 #:use-module (gnu packages bootstrap)
e387ab7c 34 #:use-module ((gnu packages guile) #:select (guile-1.8))
b37eb5ed 35 #:use-module (srfi srfi-1)
fb3eec83 36 #:use-module (srfi srfi-11)
341c6fdd 37 #:use-module (srfi srfi-26)
99634e3f 38 #:use-module (srfi srfi-34)
341c6fdd 39 #:use-module (srfi srfi-64)
fb3eec83 40 #:use-module (rnrs io ports)
749c6567 41 #:use-module (rnrs bytevectors)
dd36b51b 42 #:use-module (web uri)
b37eb5ed 43 #:use-module (ice-9 rdelim)
db393b33 44 #:use-module (ice-9 regex)
99634e3f
LC
45 #:use-module (ice-9 ftw)
46 #:use-module (ice-9 match))
341c6fdd 47
26bbbb95 48(define %store
c1bc358f 49 (open-connection-for-tests))
b272c474 50
ef8de985
LC
51;; Globally disable grafts because they can trigger early builds.
52(%graft? #f)
53
5b0c9d16
LC
54(define (bootstrap-binary name)
55 (let ((bin (search-bootstrap-binary name (%current-system))))
97d3998e 56 (and %store
5b0c9d16
LC
57 (add-to-store %store name #t "sha256" bin))))
58
59(define %bash
60 (bootstrap-binary "bash"))
61(define %mkdir
62 (bootstrap-binary "mkdir"))
97d3998e 63
5b0c9d16 64(define* (directory-contents dir #:optional (slurp get-bytevector-all))
b37eb5ed
LC
65 "Return an alist representing the contents of DIR."
66 (define prefix-len (string-length dir))
67 (sort (file-system-fold (const #t) ; enter?
68 (lambda (path stat result) ; leaf
69 (alist-cons (string-drop path prefix-len)
5b0c9d16 70 (call-with-input-file path slurp)
b37eb5ed
LC
71 result))
72 (lambda (path stat result) result) ; down
73 (lambda (path stat result) result) ; up
74 (lambda (path stat result) result) ; skip
75 (lambda (path stat errno result) result) ; error
76 '()
77 dir)
78 (lambda (e1 e2)
79 (string<? (car e1) (car e2)))))
80
94d92c77
LC
81;; Avoid collisions with other tests.
82(%http-server-port 10500)
83
ef8de985 84\f
341c6fdd
LC
85(test-begin "derivations")
86
87(test-assert "parse & export"
33594aa4
LC
88 (let* ((f (search-path %load-path "tests/test.drv"))
89 (b1 (call-with-input-file f get-bytevector-all))
5cf4b26d
LC
90 (d1 (read-derivation (open-bytevector-input-port b1)
91 identity))
341c6fdd 92 (b2 (call-with-bytevector-output-port (cut write-derivation d1 <>)))
5cf4b26d
LC
93 (d2 (read-derivation (open-bytevector-input-port b2)
94 identity)))
341c6fdd
LC
95 (and (equal? b1 b2)
96 (equal? d1 d2))))
97
5b0c9d16 98(test-skip (if %store 0 12))
b37eb5ed 99
d1b1c424 100(test-assert "add-to-store, flat"
9d6fae65
LC
101 ;; Use 'readlink*' in case spec.scm is a symlink, as is the case when Guile
102 ;; was installed with Stow.
103 (let* ((file (readlink*
104 (search-path %load-path "language/tree-il/spec.scm")))
a9ebd9ef 105 (drv (add-to-store %store "flat-test" #f "sha256" file)))
d1b1c424 106 (and (eq? 'regular (stat:type (stat drv)))
31ef99a8 107 (valid-path? %store drv)
d1b1c424
LC
108 (equal? (call-with-input-file file get-bytevector-all)
109 (call-with-input-file drv get-bytevector-all)))))
110
b37eb5ed 111(test-assert "add-to-store, recursive"
9d6fae65
LC
112 (let* ((dir (dirname
113 (readlink* (search-path %load-path
114 "language/tree-il/spec.scm"))))
a9ebd9ef 115 (drv (add-to-store %store "dir-tree-test" #t "sha256" dir)))
b37eb5ed 116 (and (eq? 'directory (stat:type (stat drv)))
31ef99a8 117 (valid-path? %store drv)
b37eb5ed
LC
118 (equal? (directory-contents dir)
119 (directory-contents drv)))))
26bbbb95
LC
120
121(test-assert "derivation with no inputs"
31ef99a8 122 (let* ((builder (add-text-to-store %store "my-builder.sh"
97d3998e 123 "echo hello, world\n"
31ef99a8 124 '()))
59688fc4 125 (drv (derivation %store "foo"
97d3998e 126 %bash `("-e" ,builder)
a987d2c0 127 #:env-vars '(("HOME" . "/homeless")))))
59688fc4
LC
128 (and (store-path? (derivation-file-name drv))
129 (valid-path? %store (derivation-file-name drv)))))
26bbbb95 130
fb3eec83 131(test-assert "build derivation with 1 source"
59688fc4
LC
132 (let* ((builder (add-text-to-store %store "my-builder.sh"
133 "echo hello, world > \"$out\"\n"
134 '()))
135 (drv (derivation %store "foo"
136 %bash `(,builder)
137 #:env-vars '(("HOME" . "/homeless")
138 ("zzz" . "Z!")
139 ("AAA" . "A!"))
bde2d9cf 140 #:inputs `((,%bash) (,builder))))
59688fc4
LC
141 (succeeded?
142 (build-derivations %store (list drv))))
fb3eec83 143 (and succeeded?
59688fc4 144 (let ((path (derivation->output-path drv)))
31ef99a8
LC
145 (and (valid-path? %store path)
146 (string=? (call-with-input-file path read-line)
147 "hello, world"))))))
fb3eec83 148
860a6f1a
LC
149(test-assert "derivation with local file as input"
150 (let* ((builder (add-text-to-store
151 %store "my-builder.sh"
bbb76f6f 152 "(while read line ; do echo \"$line\" ; done) < $in > $out"
860a6f1a
LC
153 '()))
154 (input (search-path %load-path "ice-9/boot-9.scm"))
a987d2c0
LC
155 (input* (add-to-store %store (basename input)
156 #t "sha256" input))
59688fc4 157 (drv (derivation %store "derivation-with-input-file"
97d3998e 158 %bash `(,builder)
a987d2c0
LC
159
160 ;; Cheat to pass the actual file name to the
161 ;; builder.
162 #:env-vars `(("in" . ,input*))
163
bde2d9cf
LC
164 #:inputs `((,%bash)
165 (,builder)
a987d2c0 166 (,input))))) ; ← local file name
59688fc4 167 (and (build-derivations %store (list drv))
bbb76f6f
LC
168 ;; Note: we can't compare the files because the above trick alters
169 ;; the contents.
59688fc4 170 (valid-path? %store (derivation->output-path drv)))))
860a6f1a 171
0e510971
LC
172(test-assert "derivation fails but keep going"
173 ;; In keep-going mode, 'build-derivations' should fail because of D1, but it
174 ;; must return only after D2 has succeeded.
175 (with-store store
176 (let* ((d1 (derivation %store "fails"
177 %bash `("-c" "false")
178 #:inputs `((,%bash))))
179 (d2 (build-expression->derivation %store "sleep-then-succeed"
180 `(begin
181 ,(random-text)
182 ;; XXX: Hopefully that's long
183 ;; enough that D1 has already
184 ;; failed.
185 (sleep 2)
186 (mkdir %output)))))
187 (set-build-options %store
188 #:use-substitutes? #f
189 #:keep-going? #t)
f9e8a123
LC
190 (guard (c ((store-protocol-error? c)
191 (and (= 100 (store-protocol-error-status c))
192 (string-contains (store-protocol-error-message c)
0e510971
LC
193 (derivation-file-name d1))
194 (not (valid-path? %store (derivation->output-path d1)))
195 (valid-path? %store (derivation->output-path d2)))))
196 (build-derivations %store (list d1 d2))
197 #f))))
198
44d43c7a
LC
199(test-assert "identical files are deduplicated"
200 (let* ((build1 (add-text-to-store %store "one.sh"
201 "echo hello, world > \"$out\"\n"
202 '()))
203 (build2 (add-text-to-store %store "two.sh"
204 "# Hey!\necho hello, world > \"$out\"\n"
205 '()))
206 (drv1 (derivation %store "foo"
207 %bash `(,build1)
208 #:inputs `((,%bash) (,build1))))
209 (drv2 (derivation %store "bar"
210 %bash `(,build2)
211 #:inputs `((,%bash) (,build2)))))
212 (and (build-derivations %store (list drv1 drv2))
213 (let ((file1 (derivation->output-path drv1))
214 (file2 (derivation->output-path drv2)))
215 (and (valid-path? %store file1) (valid-path? %store file2)
216 (string=? (call-with-input-file file1 get-string-all)
217 "hello, world\n")
218 (= (stat:ino (lstat file1))
219 (stat:ino (lstat file2))))))))
220
f9aefa2d
LC
221(test-equal "built-in-builders"
222 '("download")
223 (built-in-builders %store))
224
94d92c77
LC
225(test-assert "unknown built-in builder"
226 (let ((drv (derivation %store "ohoh" "builtin:does-not-exist" '())))
f9e8a123
LC
227 (guard (c ((store-protocol-error? c)
228 (string-contains (store-protocol-error-message c) "failed")))
94d92c77
LC
229 (build-derivations %store (list drv))
230 #f)))
231
6ea10db9 232(unless (http-server-can-listen?)
94d92c77
LC
233 (test-skip 1))
234(test-assert "'download' built-in builder"
235 (let ((text (random-text)))
236 (with-http-server 200 text
237 (let* ((drv (derivation %store "world"
238 "builtin:download" '()
239 #:env-vars `(("url"
240 . ,(object->string (%local-url))))
241 #:hash-algo 'sha256
242 #:hash (sha256 (string->utf8 text)))))
243 (and (build-derivations %store (list drv))
244 (string=? (call-with-input-file (derivation->output-path drv)
245 get-string-all)
246 text))))))
247
6ea10db9 248(unless (http-server-can-listen?)
94d92c77
LC
249 (test-skip 1))
250(test-assert "'download' built-in builder, invalid hash"
251 (with-http-server 200 "hello, world!"
252 (let* ((drv (derivation %store "world"
253 "builtin:download" '()
254 #:env-vars `(("url"
255 . ,(object->string (%local-url))))
256 #:hash-algo 'sha256
257 #:hash (sha256 (random-bytevector 100))))) ;wrong
f9e8a123
LC
258 (guard (c ((store-protocol-error? c)
259 (string-contains (store-protocol-error-message c) "failed")))
94d92c77
LC
260 (build-derivations %store (list drv))
261 #f))))
262
6ea10db9 263(unless (http-server-can-listen?)
94d92c77
LC
264 (test-skip 1))
265(test-assert "'download' built-in builder, not found"
266 (with-http-server 404 "not found"
267 (let* ((drv (derivation %store "will-never-be-found"
268 "builtin:download" '()
269 #:env-vars `(("url"
270 . ,(object->string (%local-url))))
271 #:hash-algo 'sha256
272 #:hash (sha256 (random-bytevector 100)))))
f9e8a123
LC
273 (guard (c ((store-protocol-error? c)
274 (string-contains (store-protocol-error-message (pk c)) "failed")))
94d92c77
LC
275 (build-derivations %store (list drv))
276 #f))))
277
278(test-assert "'download' built-in builder, not fixed-output"
279 (let* ((source (add-text-to-store %store "hello" "hi!"))
280 (url (string-append "file://" source))
281 (drv (derivation %store "world"
282 "builtin:download" '()
283 #:env-vars `(("url" . ,(object->string url))))))
f9e8a123
LC
284 (guard (c ((store-protocol-error? c)
285 (string-contains (store-protocol-error-message c) "failed")))
94d92c77
LC
286 (build-derivations %store (list drv))
287 #f)))
288
6ea10db9 289(unless (http-server-can-listen?)
9b5364a3
LC
290 (test-skip 1))
291(test-assert "'download' built-in builder, check mode"
292 ;; Make sure rebuilding the 'builtin:download' derivation in check mode
293 ;; works. See <http://bugs.gnu.org/25089>.
294 (let* ((text (random-text))
295 (drv (derivation %store "world"
296 "builtin:download" '()
297 #:env-vars `(("url"
298 . ,(object->string (%local-url))))
299 #:hash-algo 'sha256
300 #:hash (sha256 (string->utf8 text)))))
301 (and (with-http-server 200 text
302 (build-derivations %store (list drv)))
303 (with-http-server 200 text
304 (build-derivations %store (list drv)
305 (build-mode check)))
306 (string=? (call-with-input-file (derivation->output-path drv)
307 get-string-all)
308 text))))
309
e786293e
LC
310(test-equal "derivation-name"
311 "foo-0.0"
312 (let ((drv (derivation %store "foo-0.0" %bash '())))
313 (derivation-name drv)))
314
0b6af195
LC
315(test-equal "derivation-output-names"
316 '(("out") ("bar" "chbouib"))
317 (let ((drv1 (derivation %store "foo-0.0" %bash '()))
318 (drv2 (derivation %store "foo-0.0" %bash '()
319 #:outputs '("bar" "chbouib"))))
320 (list (derivation-output-names drv1)
321 (derivation-output-names drv2))))
322
fc93e309
LC
323(test-assert "offloadable-derivation?"
324 (and (offloadable-derivation? (derivation %store "foo" %bash '()))
4a6aeb67
LC
325 (offloadable-derivation? ;see <http://bugs.gnu.org/18747>
326 (derivation %store "foo" %bash '()
327 #:substitutable? #f))
fc93e309
LC
328 (not (offloadable-derivation?
329 (derivation %store "foo" %bash '()
330 #:local-build? #t)))))
331
4a6aeb67
LC
332(test-assert "substitutable-derivation?"
333 (and (substitutable-derivation? (derivation %store "foo" %bash '()))
334 (substitutable-derivation? ;see <http://bugs.gnu.org/18747>
335 (derivation %store "foo" %bash '()
cfc5d398 336 #:local-build? #t))
4a6aeb67
LC
337 (not (substitutable-derivation?
338 (derivation %store "foo" %bash '()
339 #:substitutable? #f)))))
340
99e17dc9
LC
341(test-assert "fixed-output-derivation?"
342 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
343 "echo -n hello > $out" '()))
344 (hash (sha256 (string->utf8 "hello")))
345 (drv (derivation %store "fixed"
346 %bash `(,builder)
347 #:inputs `((,builder))
348 #:hash hash #:hash-algo 'sha256)))
349 (fixed-output-derivation? drv)))
350
749c6567
LC
351(test-assert "fixed-output derivation"
352 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
353 "echo -n hello > $out" '()))
354 (hash (sha256 (string->utf8 "hello")))
59688fc4 355 (drv (derivation %store "fixed"
97d3998e 356 %bash `(,builder)
a987d2c0 357 #:inputs `((,builder)) ; optional
749c6567 358 #:hash hash #:hash-algo 'sha256))
59688fc4 359 (succeeded? (build-derivations %store (list drv))))
749c6567 360 (and succeeded?
59688fc4 361 (let ((p (derivation->output-path drv)))
82058eff
LC
362 (and (equal? (string->utf8 "hello")
363 (call-with-input-file p get-bytevector-all))
364 (bytevector? (query-path-hash %store p)))))))
749c6567 365
813986ac
LC
366(test-assert "fixed-output derivation: output paths are equal"
367 (let* ((builder1 (add-text-to-store %store "fixed-builder1.sh"
368 "echo -n hello > $out" '()))
369 (builder2 (add-text-to-store %store "fixed-builder2.sh"
370 "echo hey; echo -n hello > $out" '()))
371 (hash (sha256 (string->utf8 "hello")))
59688fc4 372 (drv1 (derivation %store "fixed"
97d3998e 373 %bash `(,builder1)
813986ac 374 #:hash hash #:hash-algo 'sha256))
59688fc4 375 (drv2 (derivation %store "fixed"
97d3998e 376 %bash `(,builder2)
813986ac 377 #:hash hash #:hash-algo 'sha256))
59688fc4 378 (succeeded? (build-derivations %store (list drv1 drv2))))
813986ac 379 (and succeeded?
59688fc4
LC
380 (equal? (derivation->output-path drv1)
381 (derivation->output-path drv2)))))
813986ac 382
36bbbbd1
LC
383(test-assert "fixed-output derivation, recursive"
384 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
385 "echo -n hello > $out" '()))
386 (hash (sha256 (string->utf8 "hello")))
387 (drv (derivation %store "fixed-rec"
388 %bash `(,builder)
389 #:inputs `((,builder))
390 #:hash (base32 "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
391 #:hash-algo 'sha256
392 #:recursive? #t))
393 (succeeded? (build-derivations %store (list drv))))
394 (and succeeded?
395 (let ((p (derivation->output-path drv)))
396 (and (equal? (string->utf8 "hello")
397 (call-with-input-file p get-bytevector-all))
398 (bytevector? (query-path-hash %store p)))))))
399
813986ac
LC
400(test-assert "derivation with a fixed-output input"
401 ;; A derivation D using a fixed-output derivation F doesn't has the same
402 ;; output path when passed F or F', as long as F and F' have the same output
403 ;; path.
404 (let* ((builder1 (add-text-to-store %store "fixed-builder1.sh"
405 "echo -n hello > $out" '()))
406 (builder2 (add-text-to-store %store "fixed-builder2.sh"
407 "echo hey; echo -n hello > $out" '()))
408 (hash (sha256 (string->utf8 "hello")))
a987d2c0 409 (fixed1 (derivation %store "fixed"
97d3998e 410 %bash `(,builder1)
813986ac 411 #:hash hash #:hash-algo 'sha256))
a987d2c0 412 (fixed2 (derivation %store "fixed"
97d3998e 413 %bash `(,builder2)
813986ac 414 #:hash hash #:hash-algo 'sha256))
59688fc4 415 (fixed-out (derivation->output-path fixed1))
813986ac
LC
416 (builder3 (add-text-to-store
417 %store "final-builder.sh"
418 ;; Use Bash hackery to avoid Coreutils.
419 "echo $in ; (read -u 3 c; echo $c) 3< $in > $out" '()))
a987d2c0 420 (final1 (derivation %store "final"
97d3998e 421 %bash `(,builder3)
a987d2c0 422 #:env-vars `(("in" . ,fixed-out))
bde2d9cf 423 #:inputs `((,%bash) (,builder3) (,fixed1))))
a987d2c0 424 (final2 (derivation %store "final"
97d3998e 425 %bash `(,builder3)
a987d2c0 426 #:env-vars `(("in" . ,fixed-out))
bde2d9cf 427 #:inputs `((,%bash) (,builder3) (,fixed2))))
813986ac
LC
428 (succeeded? (build-derivations %store
429 (list final1 final2))))
430 (and succeeded?
59688fc4
LC
431 (equal? (derivation->output-path final1)
432 (derivation->output-path final2)))))
813986ac 433
7946c4e7
LC
434(test-assert "multiple-output derivation"
435 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
436 "echo one > $out ; echo two > $second"
437 '()))
59688fc4 438 (drv (derivation %store "fixed"
97d3998e 439 %bash `(,builder)
a987d2c0
LC
440 #:env-vars '(("HOME" . "/homeless")
441 ("zzz" . "Z!")
442 ("AAA" . "A!"))
bde2d9cf 443 #:inputs `((,%bash) (,builder))
7946c4e7 444 #:outputs '("out" "second")))
59688fc4 445 (succeeded? (build-derivations %store (list drv))))
7946c4e7 446 (and succeeded?
59688fc4
LC
447 (let ((one (derivation->output-path drv "out"))
448 (two (derivation->output-path drv "second")))
7244a5f7 449 (and (lset= equal?
59688fc4 450 (derivation->output-paths drv)
7244a5f7
LC
451 `(("out" . ,one) ("second" . ,two)))
452 (eq? 'one (call-with-input-file one read))
7946c4e7
LC
453 (eq? 'two (call-with-input-file two read)))))))
454
4b1786aa
LC
455(test-assert "multiple-output derivation, non-alphabetic order"
456 ;; Here, the outputs are not listed in alphabetic order. Yet, the store
457 ;; path computation must reorder them first.
458 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
459 "echo one > $out ; echo two > $AAA"
460 '()))
59688fc4 461 (drv (derivation %store "fixed"
97d3998e 462 %bash `(,builder)
bde2d9cf 463 #:inputs `((,%bash) (,builder))
4b1786aa 464 #:outputs '("out" "AAA")))
59688fc4 465 (succeeded? (build-derivations %store (list drv))))
4b1786aa 466 (and succeeded?
59688fc4
LC
467 (let ((one (derivation->output-path drv "out"))
468 (two (derivation->output-path drv "AAA")))
4b1786aa
LC
469 (and (eq? 'one (call-with-input-file one read))
470 (eq? 'two (call-with-input-file two read)))))))
471
97507ebe
LC
472(test-assert "read-derivation vs. derivation"
473 ;; Make sure 'derivation' and 'read-derivation' return objects that are
474 ;; identical.
475 (let* ((sources (unfold (cut >= <> 10)
476 (lambda (n)
477 (add-text-to-store %store
478 (format #f "input~a" n)
479 (random-text)))
480 1+
481 0))
482 (inputs (map (lambda (file)
483 (derivation %store "derivation-input"
484 %bash '()
485 #:inputs `((,%bash) (,file))))
486 sources))
487 (builder (add-text-to-store %store "builder.sh"
488 "echo one > $one ; echo two > $two"
489 '()))
490 (drv (derivation %store "derivation"
491 %bash `(,builder)
492 #:inputs `((,%bash) (,builder)
493 ,@(map list (append sources inputs)))
494 #:outputs '("two" "one")))
495 (drv* (call-with-input-file (derivation-file-name drv)
496 read-derivation)))
497 (equal? drv* drv)))
498
d0dc4907
LC
499(test-assert "multiple-output derivation, derivation-path->output-path"
500 (let* ((builder (add-text-to-store %store "builder.sh"
501 "echo one > $out ; echo two > $second"
502 '()))
503 (drv (derivation %store "multiple"
504 %bash `(,builder)
505 #:outputs '("out" "second")))
506 (drv-file (derivation-file-name drv))
507 (one (derivation->output-path drv "out"))
508 (two (derivation->output-path drv "second"))
509 (first (derivation-path->output-path drv-file "out"))
510 (second (derivation-path->output-path drv-file "second")))
511 (and (not (string=? one two))
512 (string-suffix? "-second" two)
513 (string=? first one)
514 (string=? second two))))
515
d66ac374
LC
516(test-assert "user of multiple-output derivation"
517 ;; Check whether specifying several inputs coming from the same
518 ;; multiple-output derivation works.
519 (let* ((builder1 (add-text-to-store %store "my-mo-builder.sh"
520 "echo one > $out ; echo two > $two"
521 '()))
a987d2c0 522 (mdrv (derivation %store "multiple-output"
97d3998e 523 %bash `(,builder1)
bde2d9cf 524 #:inputs `((,%bash) (,builder1))
d66ac374
LC
525 #:outputs '("out" "two")))
526 (builder2 (add-text-to-store %store "my-mo-user-builder.sh"
527 "read x < $one;
528 read y < $two;
529 echo \"($x $y)\" > $out"
530 '()))
531 (udrv (derivation %store "multiple-output-user"
97d3998e 532 %bash `(,builder2)
a987d2c0 533 #:env-vars `(("one"
59688fc4 534 . ,(derivation->output-path
a987d2c0
LC
535 mdrv "out"))
536 ("two"
59688fc4 537 . ,(derivation->output-path
a987d2c0 538 mdrv "two")))
bde2d9cf
LC
539 #:inputs `((,%bash)
540 (,builder2)
a987d2c0
LC
541 ;; two occurrences of MDRV:
542 (,mdrv)
543 (,mdrv "two")))))
d66ac374 544 (and (build-derivations %store (list (pk 'udrv udrv)))
59688fc4 545 (let ((p (derivation->output-path udrv)))
d66ac374
LC
546 (and (valid-path? %store p)
547 (equal? '(one two) (call-with-input-file p read)))))))
548
858e9282 549(test-assert "derivation with #:references-graphs"
5b0c9d16
LC
550 (let* ((input1 (add-text-to-store %store "foo" "hello"
551 (list %bash)))
552 (input2 (add-text-to-store %store "bar"
553 (number->string (random 7777))
554 (list input1)))
555 (builder (add-text-to-store %store "build-graph"
556 (format #f "
557~a $out
558 (while read l ; do echo $l ; done) < bash > $out/bash
559 (while read l ; do echo $l ; done) < input1 > $out/input1
560 (while read l ; do echo $l ; done) < input2 > $out/input2"
561 %mkdir)
562 (list %mkdir)))
563 (drv (derivation %store "closure-graphs"
564 %bash `(,builder)
858e9282 565 #:references-graphs
5b0c9d16
LC
566 `(("bash" . ,%bash)
567 ("input1" . ,input1)
568 ("input2" . ,input2))
569 #:inputs `((,%bash) (,builder))))
59688fc4 570 (out (derivation->output-path drv)))
5b0c9d16
LC
571 (define (deps path . deps)
572 (let ((count (length deps)))
573 (string-append path "\n\n" (number->string count) "\n"
574 (string-join (sort deps string<?) "\n")
575 (if (zero? count) "" "\n"))))
576
577 (and (build-derivations %store (list drv))
578 (equal? (directory-contents out get-string-all)
579 `(("/bash" . ,(string-append %bash "\n\n0\n"))
580 ("/input1" . ,(if (string>? input1 %bash)
581 (string-append (deps %bash)
582 (deps input1 %bash))
583 (string-append (deps input1 %bash)
584 (deps %bash))))
585 ("/input2" . ,(string-concatenate
586 (map cdr
587 (sort
588 (map (lambda (p d)
589 (cons p (apply deps p d)))
590 (list %bash input1 input2)
591 (list '() (list %bash) (list input1)))
592 (lambda (x y)
593 (match x
594 ((p1 . _)
595 (match y
596 ((p2 . _)
597 (string<? p1 p2)))))))))))))))
598
b53be755
LC
599(test-assert "derivation #:allowed-references, ok"
600 (let ((drv (derivation %store "allowed" %bash
601 '("-c" "echo hello > $out")
602 #:inputs `((,%bash))
603 #:allowed-references '())))
604 (build-derivations %store (list drv))))
605
606(test-assert "derivation #:allowed-references, not allowed"
607 (let* ((txt (add-text-to-store %store "foo" "Hello, world."))
608 (drv (derivation %store "disallowed" %bash
609 `("-c" ,(string-append "echo " txt "> $out"))
610 #:inputs `((,%bash) (,txt))
611 #:allowed-references '())))
f9e8a123 612 (guard (c ((store-protocol-error? c)
b53be755
LC
613 ;; There's no specific error message to check for.
614 #t))
615 (build-derivations %store (list drv))
616 #f)))
617
618(test-assert "derivation #:allowed-references, self allowed"
619 (let ((drv (derivation %store "allowed" %bash
620 '("-c" "echo $out > $out")
621 #:inputs `((,%bash))
622 #:allowed-references '("out"))))
623 (build-derivations %store (list drv))))
624
625(test-assert "derivation #:allowed-references, self not allowed"
626 (let ((drv (derivation %store "disallowed" %bash
627 `("-c" ,"echo $out > $out")
628 #:inputs `((,%bash))
629 #:allowed-references '())))
f9e8a123 630 (guard (c ((store-protocol-error? c)
b53be755
LC
631 ;; There's no specific error message to check for.
632 #t))
633 (build-derivations %store (list drv))
634 #f)))
635
35b5ca78
LC
636(test-assert "derivation #:disallowed-references, ok"
637 (let ((drv (derivation %store "disallowed" %bash
638 '("-c" "echo hello > $out")
639 #:inputs `((,%bash))
640 #:disallowed-references '("out"))))
641 (build-derivations %store (list drv))))
642
643(test-assert "derivation #:disallowed-references, not ok"
644 (let* ((txt (add-text-to-store %store "foo" "Hello, world."))
645 (drv (derivation %store "disdisallowed" %bash
646 `("-c" ,(string-append "echo " txt "> $out"))
647 #:inputs `((,%bash) (,txt))
648 #:disallowed-references (list txt))))
f9e8a123 649 (guard (c ((store-protocol-error? c)
35b5ca78
LC
650 ;; There's no specific error message to check for.
651 #t))
652 (build-derivations %store (list drv))
653 #f)))
654
a87d66f3
LC
655;; Here we should get the value of $GUIX_STATE_DIRECTORY that the daemon sees,
656;; which is a unique value for each test process; this value is the same as
657;; the one we see in the process executing this file since it is set by
658;; 'test-env'.
44ad3384 659(test-equal "derivation #:leaked-env-vars"
a87d66f3
LC
660 (getenv "GUIX_STATE_DIRECTORY")
661 (let* ((value (getenv "GUIX_STATE_DIRECTORY"))
44ad3384 662 (drv (derivation %store "leaked-env-vars" %bash
a87d66f3 663 '("-c" "echo -n $GUIX_STATE_DIRECTORY > $out")
44ad3384
LC
664 #:hash (sha256 (string->utf8 value))
665 #:hash-algo 'sha256
666 #:inputs `((,%bash))
a87d66f3 667 #:leaked-env-vars '("GUIX_STATE_DIRECTORY"))))
44ad3384
LC
668 (and (build-derivations %store (list drv))
669 (call-with-input-file (derivation->output-path drv)
670 get-string-all))))
671
de4c3f26
LC
672\f
673(define %coreutils
8f3ecbd7 674 (false-if-exception
12d720fd 675 (and (network-reachable?)
f073e523 676 (package-derivation %store %bootstrap-coreutils&co))))
de4c3f26
LC
677
678(test-skip (if %coreutils 0 1))
679
680(test-assert "build derivation with coreutils"
681 (let* ((builder
682 (add-text-to-store %store "build-with-coreutils.sh"
683 "echo $PATH ; mkdir --version ; mkdir $out ; touch $out/good"
684 '()))
59688fc4 685 (drv
a987d2c0 686 (derivation %store "foo"
97d3998e 687 %bash `(,builder)
a987d2c0
LC
688 #:env-vars `(("PATH" .
689 ,(string-append
59688fc4 690 (derivation->output-path %coreutils)
a987d2c0
LC
691 "/bin")))
692 #:inputs `((,builder)
693 (,%coreutils))))
de4c3f26 694 (succeeded?
59688fc4 695 (build-derivations %store (list drv))))
de4c3f26 696 (and succeeded?
59688fc4 697 (let ((p (derivation->output-path drv)))
31ef99a8
LC
698 (and (valid-path? %store p)
699 (file-exists? (string-append p "/good")))))))
de4c3f26 700
9c629a27 701(test-skip (if (%guile-for-build) 0 8))
9a20830e 702
d26e1967
LC
703(test-equal "build-expression->derivation and invalid module name"
704 '(file-search-error "guix/module/that/does/not/exist.scm")
705 (guard (c ((file-search-error? c)
706 (list 'file-search-error
707 (file-search-error-file-name c))))
708 (build-expression->derivation %store "foo" #t
709 #:modules '((guix module that
710 does not exist)))))
711
9231ef12
LC
712(test-equal "build-expression->derivation and builder encoding"
713 '("UTF-8" #t)
714 (let* ((exp '(λ (α) (+ α 1)))
715 (drv (build-expression->derivation %store "foo" exp)))
716 (match (derivation-builder-arguments drv)
717 ((... builder)
8a8e2d2e
LC
718 (with-fluids ((%default-port-encoding "UTF-8"))
719 (call-with-input-file builder
720 (lambda (port)
721 (list (port-encoding port)
722 (->bool
723 (string-contains (get-string-all port)
724 "(λ (α) (+ α 1))"))))))))))
9231ef12 725
9a20830e 726(test-assert "build-expression->derivation and derivation-prerequisites"
dd1a5a15 727 (let ((drv (build-expression->derivation %store "fail" #f)))
9a20830e 728 (any (match-lambda
5cf4b26d 729 (($ <derivation-input> (= derivation-file-name path))
59688fc4 730 (string=? path (derivation-file-name (%guile-for-build)))))
9a20830e 731 (derivation-prerequisites drv))))
d9085c23 732
49c0a8d6 733(test-assert "derivation-prerequisites and valid-derivation-input?"
3681db5d
LC
734 (let* ((a (build-expression->derivation %store "a" '(mkdir %output)))
735 (b (build-expression->derivation %store "b" `(list ,(random-text))))
736 (c (build-expression->derivation %store "c" `(mkdir %output)
737 #:inputs `(("a" ,a) ("b" ,b)))))
49c0a8d6
LC
738 ;; Make sure both A and %BOOTSTRAP-GUILE are built (the latter could have
739 ;; be removed by tests/guix-gc.sh.)
740 (build-derivations %store
741 (list a (package-derivation %store %bootstrap-guile)))
742
3681db5d
LC
743 (match (derivation-prerequisites c
744 (cut valid-derivation-input? %store
745 <>))
5cf4b26d 746 ((($ <derivation-input> (= derivation-file-name file) ("out")))
3681db5d
LC
747 (string=? file (derivation-file-name b)))
748 (x
749 (pk 'fail x #f)))))
750
d9085c23
LC
751(test-assert "build-expression->derivation without inputs"
752 (let* ((builder '(begin
753 (mkdir %output)
754 (call-with-output-file (string-append %output "/test")
755 (lambda (p)
756 (display '(hello guix) p)))))
dd1a5a15 757 (drv (build-expression->derivation %store "goo" builder))
59688fc4 758 (succeeded? (build-derivations %store (list drv))))
d9085c23 759 (and succeeded?
59688fc4 760 (let ((p (derivation->output-path drv)))
d9085c23
LC
761 (equal? '(hello guix)
762 (call-with-input-file (string-append p "/test") read))))))
763
969e678e
LC
764(test-assert "build-expression->derivation and max-silent-time"
765 (let* ((store (let ((s (open-connection)))
766 (set-build-options s #:max-silent-time 1)
767 s))
01e82af5 768 (builder '(begin (sleep 100) (mkdir %output) #t))
dd1a5a15 769 (drv (build-expression->derivation store "silent" builder))
59688fc4 770 (out-path (derivation->output-path drv)))
f9e8a123
LC
771 (guard (c ((store-protocol-error? c)
772 (and (string-contains (store-protocol-error-message c)
6c20d1d0
LC
773 "failed")
774 (not (valid-path? store out-path)))))
775 (build-derivations store (list drv))
776 #f)))
777
778(test-assert "build-expression->derivation and timeout"
779 (let* ((store (let ((s (open-connection)))
780 (set-build-options s #:timeout 1)
781 s))
782 (builder '(begin (sleep 100) (mkdir %output) #t))
783 (drv (build-expression->derivation store "slow" builder))
784 (out-path (derivation->output-path drv)))
f9e8a123
LC
785 (guard (c ((store-protocol-error? c)
786 (and (string-contains (store-protocol-error-message c)
969e678e
LC
787 "failed")
788 (not (valid-path? store out-path)))))
01e82af5
LC
789 (build-derivations store (list drv))
790 #f)))
969e678e 791
f8a9f99c
LC
792(test-assert "build-derivations with specific output"
793 (with-store store
794 (let* ((content (random-text)) ;contents of the output
795 (drv (build-expression->derivation
796 store "substitute-me"
797 `(begin ,content (exit 1)) ;would fail
798 #:outputs '("out" "one" "two")
799 #:guile-for-build
800 (package-derivation store %bootstrap-guile)))
801 (out (derivation->output-path drv)))
802 (with-derivation-substitute drv content
803 (set-build-options store #:use-substitutes? #t
804 #:substitute-urls (%test-substitute-urls))
805 (and (has-substitutes? store out)
806
807 ;; Ask for nothing but the "out" output of DRV.
808 (build-derivations store `((,drv . "out")))
809
7c690a47
LC
810 ;; Synonymous:
811 (build-derivations store (list (derivation-input drv '("out"))))
812
f8a9f99c 813 (valid-path? store out)
7c690a47
LC
814 (equal? (pk 'x content)
815 (pk 'y (call-with-input-file out get-string-all))))))))
f8a9f99c 816
ba04f80e 817(test-assert "build-expression->derivation and derivation-build-plan"
dd1a5a15 818 (let ((drv (build-expression->derivation %store "fail" #f)))
9a20830e
LC
819 ;; The only direct dependency is (%guile-for-build) and it's already
820 ;; built.
ba04f80e 821 (null? (derivation-build-plan %store (derivation-inputs drv)))))
9a20830e 822
ba04f80e 823(test-assert "derivation-build-plan when outputs already present"
5c7f8788 824 (let* ((builder `(begin ,(random-text) (mkdir %output) #t))
dd1a5a15 825 (input-drv (build-expression->derivation %store "input" builder))
5c7f8788 826 (input-path (derivation->output-path input-drv))
dd1a5a15
LC
827 (drv (build-expression->derivation %store "something" builder
828 #:inputs
59688fc4
LC
829 `(("i" ,input-drv))))
830 (output (derivation->output-path drv)))
5c7f8788
LC
831 ;; Assume these things are not already built.
832 (when (or (valid-path? %store input-path)
833 (valid-path? %store output))
834 (error "things already built" input-drv))
784bb1f3 835
ba04f80e
LC
836 (and (lset= equal?
837 (map derivation-file-name
838 (derivation-build-plan %store
839 (list (derivation-input drv))))
840 (list (derivation-file-name input-drv)
841 (derivation-file-name drv)))
784bb1f3
LC
842
843 ;; Build DRV and delete its input.
59688fc4 844 (build-derivations %store (list drv))
784bb1f3
LC
845 (delete-paths %store (list input-path))
846 (not (valid-path? %store input-path))
847
848 ;; Now INPUT-PATH is missing, yet it shouldn't be listed as a
849 ;; prerequisite to build because DRV itself is already built.
ba04f80e
LC
850 (null? (derivation-build-plan %store
851 (list (derivation-input drv)))))))
784bb1f3 852
ba04f80e 853(test-assert "derivation-build-plan and substitutes"
59688fc4
LC
854 (let* ((store (open-connection))
855 (drv (build-expression->derivation store "prereq-subst"
dd1a5a15 856 (random 1000)))
e6740741 857 (output (derivation->output-path drv)))
dd36b51b 858
1950bf56 859 ;; Make sure substitutes are usable.
24f5aaaf
LC
860 (set-build-options store #:use-substitutes? #t
861 #:substitute-urls (%test-substitute-urls))
1950bf56 862
e6740741
LC
863 (with-derivation-narinfo drv
864 (let-values (((build download)
ba04f80e
LC
865 (derivation-build-plan store
866 (list (derivation-input drv))))
e6740741 867 ((build* download*)
ba04f80e
LC
868 (derivation-build-plan store
869 (list (derivation-input drv))
870 #:substitutable-info
871 (const #f))))
e6740741 872 (and (null? build)
2dc98729 873 (equal? (map substitutable-path download) (list output))
e6740741 874 (null? download*)
ba04f80e 875 (equal? (list drv) build*))))))
dd36b51b 876
ba04f80e 877(test-assert "derivation-build-plan and substitutes, non-substitutable build"
d2d0514b 878 (let* ((store (open-connection))
4a6aeb67 879 (drv (build-expression->derivation store "prereq-no-subst"
d2d0514b 880 (random 1000)
4a6aeb67 881 #:substitutable? #f))
d2d0514b
LC
882 (output (derivation->output-path drv)))
883
884 ;; Make sure substitutes are usable.
24f5aaaf
LC
885 (set-build-options store #:use-substitutes? #t
886 #:substitute-urls (%test-substitute-urls))
d2d0514b
LC
887
888 (with-derivation-narinfo drv
889 (let-values (((build download)
ba04f80e
LC
890 (derivation-build-plan store
891 (list (derivation-input drv)))))
d2d0514b 892 ;; Despite being available as a substitute, DRV will be built locally
4a6aeb67 893 ;; due to #:substitutable? #f.
d2d0514b
LC
894 (and (null? download)
895 (match build
ba04f80e
LC
896 (((= derivation-file-name build))
897 (string=? build (derivation-file-name drv)))))))))
d2d0514b 898
b1510fd8
LC
899(test-assert "derivation-build-plan and substitutes, non-substitutable dep"
900 (with-store store
901 (let* ((drv1 (build-expression->derivation store "prereq-no-subst"
902 (random 1000)
903 #:substitutable? #f))
904 (drv2 (build-expression->derivation store "substitutable"
905 (random 1000)
906 #:inputs `(("dep" ,drv1)))))
907
908 ;; Make sure substitutes are usable.
909 (set-build-options store #:use-substitutes? #t
910 #:substitute-urls (%test-substitute-urls))
911
912 (with-derivation-narinfo drv2
913 (sha256 => (make-bytevector 32 0))
914 (references => (list (derivation->output-path drv1)))
915
916 (let-values (((build download)
917 (derivation-build-plan store
918 (list (derivation-input drv2)))))
919 ;; Although DRV2 is available as a substitute, we must build its
920 ;; dependency, DRV1, due to #:substitutable? #f.
921 (and (match download
922 (((= substitutable-path item))
923 (string=? item (derivation->output-path drv2))))
924 (match build
925 (((= derivation-file-name build))
926 (string=? build (derivation-file-name drv1))))))))))
927
ba04f80e 928(test-assert "derivation-build-plan and substitutes, local build"
4a6aeb67
LC
929 (with-store store
930 (let* ((drv (build-expression->derivation store "prereq-subst-local"
931 (random 1000)
932 #:local-build? #t))
933 (output (derivation->output-path drv)))
934
935 ;; Make sure substitutes are usable.
24f5aaaf
LC
936 (set-build-options store #:use-substitutes? #t
937 #:substitute-urls (%test-substitute-urls))
4a6aeb67
LC
938
939 (with-derivation-narinfo drv
940 (let-values (((build download)
ba04f80e
LC
941 (derivation-build-plan store
942 (list (derivation-input drv)))))
cfc5d398 943 ;; #:local-build? is *not* synonymous with #:substitutable?, so we
4a6aeb67
LC
944 ;; must be able to substitute DRV's output.
945 ;; See <http://bugs.gnu.org/18747>.
946 (and (null? build)
947 (match download
2dc98729 948 (((= substitutable-path item))
4a6aeb67
LC
949 (string=? item (derivation->output-path drv))))))))))
950
ba04f80e 951(test-assert "derivation-build-plan in 'check' mode"
58c08df0
LC
952 (with-store store
953 (let* ((dep (build-expression->derivation store "dep"
954 `(begin ,(random-text)
955 (mkdir %output))))
956 (drv (build-expression->derivation store "to-check"
957 '(mkdir %output)
958 #:inputs `(("dep" ,dep)))))
959 (build-derivations store (list drv))
960 (delete-paths store (list (derivation->output-path dep)))
961
962 ;; In 'check' mode, DEP must be rebuilt.
ba04f80e
LC
963 (and (null? (derivation-build-plan store
964 (list (derivation-input drv))))
965 (lset= equal?
966 (derivation-build-plan store
967 (list (derivation-input drv))
968 #:mode (build-mode check))
969 (list drv dep))))))
58c08df0 970
bdb59b33
LC
971(test-assert "substitution-oracle and #:substitute? #f"
972 (with-store store
973 (let* ((dep (build-expression->derivation store "dep"
974 `(begin ,(random-text)
975 (mkdir %output))))
976 (drv (build-expression->derivation store "not-subst"
977 `(begin ,(random-text)
978 (mkdir %output))
979 #:substitutable? #f
980 #:inputs `(("dep" ,dep))))
981 (query #f))
982 (define (record-substitutable-path-query store paths)
983 (when query
984 (error "already called!" query))
985 (set! query paths)
986 '())
987
ef51ac21 988 (mock ((guix store) substitutable-path-info
bdb59b33
LC
989 record-substitutable-path-query)
990
991 (let ((pred (substitution-oracle store (list drv))))
992 (pred (derivation->output-path drv))))
993
994 ;; Make sure the oracle didn't try to get substitute info for DRV since
995 ;; DRV is mark as non-substitutable. Assume that GUILE-FOR-BUILD is
996 ;; already in store and thus not part of QUERY.
997 (equal? (pk 'query query)
998 (list (derivation->output-path dep))))))
999
db393b33
LC
1000(test-assert "build-expression->derivation with expression returning #f"
1001 (let* ((builder '(begin
1002 (mkdir %output)
1003 #f)) ; fail!
dd1a5a15 1004 (drv (build-expression->derivation %store "fail" builder))
59688fc4 1005 (out-path (derivation->output-path drv)))
f9e8a123 1006 (guard (c ((store-protocol-error? c)
db393b33
LC
1007 ;; Note that the output path may exist at this point, but it
1008 ;; is invalid.
31ef99a8 1009 (and (string-match "build .* failed"
f9e8a123 1010 (store-protocol-error-message c))
31ef99a8 1011 (not (valid-path? %store out-path)))))
59688fc4 1012 (build-derivations %store (list drv))
db393b33
LC
1013 #f)))
1014
9bc07f4d
LC
1015(test-assert "build-expression->derivation with two outputs"
1016 (let* ((builder '(begin
1017 (call-with-output-file (assoc-ref %outputs "out")
1018 (lambda (p)
1019 (display '(hello) p)))
1020 (call-with-output-file (assoc-ref %outputs "second")
1021 (lambda (p)
1022 (display '(world) p)))))
dd1a5a15 1023 (drv (build-expression->derivation %store "double" builder
9bc07f4d
LC
1024 #:outputs '("out"
1025 "second")))
59688fc4 1026 (succeeded? (build-derivations %store (list drv))))
9bc07f4d 1027 (and succeeded?
59688fc4
LC
1028 (let ((one (derivation->output-path drv))
1029 (two (derivation->output-path drv "second")))
9bc07f4d
LC
1030 (and (equal? '(hello) (call-with-input-file one read))
1031 (equal? '(world) (call-with-input-file two read)))))))
1032
ad1ebab3 1033(test-skip (if %coreutils 0 1))
d9085c23
LC
1034(test-assert "build-expression->derivation with one input"
1035 (let* ((builder '(call-with-output-file %output
1036 (lambda (p)
1037 (let ((cu (assoc-ref %build-inputs "cu")))
1038 (close 1)
1039 (dup2 (port->fdes p) 1)
1040 (execl (string-append cu "/bin/uname")
1041 "uname" "-a")))))
dd1a5a15
LC
1042 (drv (build-expression->derivation %store "uname" builder
1043 #:inputs
2acb2cb6 1044 `(("cu" ,%coreutils))))
59688fc4 1045 (succeeded? (build-derivations %store (list drv))))
d9085c23 1046 (and succeeded?
59688fc4 1047 (let ((p (derivation->output-path drv)))
d9085c23
LC
1048 (string-contains (call-with-input-file p read-line) "GNU")))))
1049
d9024884
LC
1050(test-assert "build-expression->derivation with modules"
1051 (let* ((builder `(begin
1052 (use-modules (guix build utils))
1053 (let ((out (assoc-ref %outputs "out")))
1054 (mkdir-p (string-append out "/guile/guix/nix"))
1055 #t)))
59688fc4 1056 (drv (build-expression->derivation %store "test-with-modules"
dd1a5a15 1057 builder
d9024884
LC
1058 #:modules
1059 '((guix build utils)))))
59688fc4
LC
1060 (and (build-derivations %store (list drv))
1061 (let* ((p (derivation->output-path drv))
d9024884
LC
1062 (s (stat (string-append p "/guile/guix/nix"))))
1063 (eq? (stat:type s) 'directory)))))
1064
813986ac
LC
1065(test-assert "build-expression->derivation: same fixed-output path"
1066 (let* ((builder1 '(call-with-output-file %output
1067 (lambda (p)
1068 (write "hello" p))))
1069 (builder2 '(call-with-output-file (pk 'difference-here! %output)
1070 (lambda (p)
1071 (write "hello" p))))
1072 (hash (sha256 (string->utf8 "hello")))
dd1a5a15 1073 (input1 (build-expression->derivation %store "fixed" builder1
813986ac
LC
1074 #:hash hash
1075 #:hash-algo 'sha256))
dd1a5a15 1076 (input2 (build-expression->derivation %store "fixed" builder2
813986ac
LC
1077 #:hash hash
1078 #:hash-algo 'sha256))
1079 (succeeded? (build-derivations %store (list input1 input2))))
1080 (and succeeded?
59688fc4
LC
1081 (not (string=? (derivation-file-name input1)
1082 (derivation-file-name input2)))
1083 (string=? (derivation->output-path input1)
1084 (derivation->output-path input2)))))
813986ac 1085
7bdd1f0e
LC
1086(test-assert "build-expression->derivation with a fixed-output input"
1087 (let* ((builder1 '(call-with-output-file %output
1088 (lambda (p)
1089 (write "hello" p))))
1090 (builder2 '(call-with-output-file (pk 'difference-here! %output)
1091 (lambda (p)
1092 (write "hello" p))))
1093 (hash (sha256 (string->utf8 "hello")))
dd1a5a15 1094 (input1 (build-expression->derivation %store "fixed" builder1
7bdd1f0e
LC
1095 #:hash hash
1096 #:hash-algo 'sha256))
dd1a5a15 1097 (input2 (build-expression->derivation %store "fixed" builder2
7bdd1f0e
LC
1098 #:hash hash
1099 #:hash-algo 'sha256))
1100 (builder3 '(let ((input (assoc-ref %build-inputs "input")))
1101 (call-with-output-file %output
1102 (lambda (out)
1103 (format #f "My input is ~a.~%" input)))))
dd1a5a15
LC
1104 (final1 (build-expression->derivation %store "final" builder3
1105 #:inputs
7bdd1f0e 1106 `(("input" ,input1))))
dd1a5a15
LC
1107 (final2 (build-expression->derivation %store "final" builder3
1108 #:inputs
7bdd1f0e 1109 `(("input" ,input2)))))
59688fc4
LC
1110 (and (string=? (derivation->output-path final1)
1111 (derivation->output-path final2))
1112 (string=? (derivation->output-path final1)
1113 (derivation-path->output-path
1114 (derivation-file-name final1)))
7bdd1f0e
LC
1115 (build-derivations %store (list final1 final2)))))
1116
36bbbbd1
LC
1117(test-assert "build-expression->derivation produces recursive fixed-output"
1118 (let* ((builder '(begin
1119 (use-modules (srfi srfi-26))
1120 (mkdir %output)
1121 (chdir %output)
1122 (call-with-output-file "exe"
1123 (cut display "executable" <>))
1124 (chmod "exe" #o777)
1125 (symlink "exe" "symlink")
1126 (mkdir "subdir")))
1127 (drv (build-expression->derivation %store "fixed-rec" builder
1128 #:hash-algo 'sha256
1129 #:hash (base32
1130 "10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p")
1131 #:recursive? #t)))
1132 (and (build-derivations %store (list drv))
1133 (let* ((dir (derivation->output-path drv))
1134 (exe (string-append dir "/exe"))
1135 (link (string-append dir "/symlink"))
1136 (subdir (string-append dir "/subdir")))
1137 (and (executable-file? exe)
1138 (string=? "executable"
1139 (call-with-input-file exe get-string-all))
1140 (string=? "exe" (readlink link))
1141 (file-is-directory? subdir))))))
1142
1143(test-assert "build-expression->derivation uses recursive fixed-output"
1144 (let* ((builder '(call-with-output-file %output
1145 (lambda (port)
1146 (display "hello" port))))
1147 (fixed (build-expression->derivation %store "small-fixed-rec"
1148 builder
1149 #:hash-algo 'sha256
1150 #:hash (base32
1151 "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
1152 #:recursive? #t))
1153 (in (derivation->output-path fixed))
1154 (builder `(begin
1155 (mkdir %output)
1156 (chdir %output)
1157 (symlink ,in "symlink")))
1158 (drv (build-expression->derivation %store "fixed-rec-user"
1159 builder
1160 #:inputs `(("fixed" ,fixed)))))
1161 (and (build-derivations %store (list drv))
1162 (let ((out (derivation->output-path drv)))
1163 (string=? (readlink (string-append out "/symlink")) in)))))
1164
858e9282 1165(test-assert "build-expression->derivation with #:references-graphs"
9c629a27
LC
1166 (let* ((input (add-text-to-store %store "foo" "hello"
1167 (list %bash %mkdir)))
1168 (builder '(copy-file "input" %output))
858e9282 1169 (drv (build-expression->derivation %store "references-graphs"
dd1a5a15 1170 builder
858e9282 1171 #:references-graphs
9c629a27 1172 `(("input" . ,input))))
59688fc4 1173 (out (derivation->output-path drv)))
9c629a27
LC
1174 (define (deps path . deps)
1175 (let ((count (length deps)))
1176 (string-append path "\n\n" (number->string count) "\n"
1177 (string-join (sort deps string<?) "\n")
1178 (if (zero? count) "" "\n"))))
1179
1180 (and (build-derivations %store (list drv))
1181 (equal? (call-with-input-file out get-string-all)
1182 (string-concatenate
1183 (map cdr
1184 (sort (map (lambda (p d)
1185 (cons p (apply deps p d)))
1186 (list input %bash %mkdir)
1187 (list (list %bash %mkdir)
1188 '() '()))
1189 (lambda (x y)
1190 (match x
1191 ((p1 . _)
1192 (match y
1193 ((p2 . _)
1194 (string<? p1 p2)))))))))))))
1195
8856f409
LC
1196(test-equal "derivation-properties"
1197 (list '() '((type . test)))
1198 (let ((drv1 (build-expression->derivation %store "bar"
1199 '(mkdir %output)))
1200 (drv2 (build-expression->derivation %store "foo"
1201 '(mkdir %output)
1202 #:properties '((type . test)))))
1203 (list (derivation-properties drv1)
1204 (derivation-properties drv2))))
1205
e387ab7c
LC
1206(test-equal "map-derivation"
1207 "hello"
1208 (let* ((joke (package-derivation %store guile-1.8))
1209 (good (package-derivation %store %bootstrap-guile))
1210 (drv1 (build-expression->derivation %store "original-drv1"
e387ab7c 1211 #f ; systematically fail
e387ab7c
LC
1212 #:guile-for-build joke))
1213 (drv2 (build-expression->derivation %store "original-drv2"
e387ab7c
LC
1214 '(call-with-output-file %output
1215 (lambda (p)
dd1a5a15 1216 (display "hello" p)))))
e387ab7c 1217 (drv3 (build-expression->derivation %store "drv-to-remap"
e387ab7c
LC
1218 '(let ((in (assoc-ref
1219 %build-inputs "in")))
1220 (copy-file in %output))
dd1a5a15 1221 #:inputs `(("in" ,drv1))
e387ab7c
LC
1222 #:guile-for-build joke))
1223 (drv4 (map-derivation %store drv3 `((,drv1 . ,drv2)
1224 (,joke . ,good))))
1225 (out (derivation->output-path drv4)))
1226 (and (build-derivations %store (list (pk 'remapped drv4)))
1227 (call-with-input-file out get-string-all))))
1228
a716e36d
LC
1229(test-equal "map-derivation, sources"
1230 "hello"
1231 (let* ((script1 (add-text-to-store %store "fail.sh" "exit 1"))
1232 (script2 (add-text-to-store %store "hi.sh" "echo -n hello > $out"))
1233 (bash-full (package-derivation %store (@ (gnu packages bash) bash)))
1234 (drv1 (derivation %store "drv-to-remap"
1235
1236 ;; XXX: This wouldn't work in practice, but if
1237 ;; we append "/bin/bash" then we can't replace
1238 ;; it with the bootstrap bash, which is a
1239 ;; single file.
1240 (derivation->output-path bash-full)
1241
1242 `("-e" ,script1)
1243 #:inputs `((,bash-full) (,script1))))
1244 (drv2 (map-derivation %store drv1
1245 `((,bash-full . ,%bash)
1246 (,script1 . ,script2))))
1247 (out (derivation->output-path drv2)))
1248 (and (build-derivations %store (list (pk 'remapped* drv2)))
1249 (call-with-input-file out get-string-all))))
1250
341c6fdd 1251(test-end)
9b5364a3
LC
1252
1253;; Local Variables:
1254;; eval: (put 'with-http-server 'scheme-indent-function 2)
1255;; End: