1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2012, 2013 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/>.
20 (define-module (test-derivations)
21 #:use-module (guix derivations)
22 #:use-module (guix store)
23 #:use-module (guix utils)
24 #:use-module (guix base32)
25 #:use-module ((guix packages) #:select (package-derivation))
26 #:use-module ((distro) #:select (search-bootstrap-binary))
27 #:use-module (distro packages bootstrap)
28 #:use-module (srfi srfi-1)
29 #:use-module (srfi srfi-11)
30 #:use-module (srfi srfi-26)
31 #:use-module (srfi srfi-34)
32 #:use-module (srfi srfi-64)
33 #:use-module (rnrs io ports)
34 #:use-module (rnrs bytevectors)
35 #:use-module (ice-9 rdelim)
36 #:use-module (ice-9 regex)
37 #:use-module (ice-9 ftw)
38 #:use-module (ice-9 match))
41 (false-if-exception (open-connection)))
44 ;; Make sure we build everything by ourselves.
45 (set-build-options %store #:use-substitutes? #f)
47 ;; By default, use %BOOTSTRAP-GUILE for the current system.
48 (let ((drv (package-derivation %store %bootstrap-guile)))
49 (%guile-for-build drv)))
52 (let ((bash (search-bootstrap-binary "bash" (%current-system))))
54 (add-to-store %store "bash" #t #t "sha256" bash))))
56 (define (directory-contents dir)
57 "Return an alist representing the contents of DIR."
58 (define prefix-len (string-length dir))
59 (sort (file-system-fold (const #t) ; enter?
60 (lambda (path stat result) ; leaf
61 (alist-cons (string-drop path prefix-len)
62 (call-with-input-file path
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 11))
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" #t #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 #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-path (derivation %store "foo" (%current-system)
108 %bash `("-e" ,builder)
109 '(("HOME" . "/homeless")) '())))
110 (and (store-path? drv-path)
111 (valid-path? %store drv-path))))
113 (test-assert "build derivation with 1 source"
114 (let*-values (((builder)
115 (add-text-to-store %store "my-builder.sh"
116 "echo hello, world > \"$out\"\n"
119 (derivation %store "foo" (%current-system)
121 '(("HOME" . "/homeless")
126 (build-derivations %store (list drv-path))))
128 (let ((path (derivation-output-path
129 (assoc-ref (derivation-outputs drv) "out"))))
130 (and (valid-path? %store path)
131 (string=? (call-with-input-file path read-line)
134 (test-assert "derivation with local file as input"
135 (let* ((builder (add-text-to-store
136 %store "my-builder.sh"
137 "(while read line ; do echo $line ; done) < $in > $out"
139 (input (search-path %load-path "ice-9/boot-9.scm"))
140 (drv-path (derivation %store "derivation-with-input-file"
144 ;; Cheat to pass the actual file
145 ;; name to the builder.
146 . ,(add-to-store %store
151 (,input))))) ; ← local file name
152 (and (build-derivations %store (list drv-path))
153 (let ((p (derivation-path->output-path drv-path)))
154 (and (call-with-input-file p get-bytevector-all)
155 (call-with-input-file input get-bytevector-all))))))
157 (test-assert "fixed-output derivation"
158 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
159 "echo -n hello > $out" '()))
160 (hash (sha256 (string->utf8 "hello")))
161 (drv-path (derivation %store "fixed" (%current-system)
164 `((,builder)) ; optional
165 #:hash hash #:hash-algo 'sha256))
166 (succeeded? (build-derivations %store (list drv-path))))
168 (let ((p (derivation-path->output-path drv-path)))
169 (and (equal? (string->utf8 "hello")
170 (call-with-input-file p get-bytevector-all))
171 (bytevector? (query-path-hash %store p)))))))
173 (test-assert "fixed-output derivation: output paths are equal"
174 (let* ((builder1 (add-text-to-store %store "fixed-builder1.sh"
175 "echo -n hello > $out" '()))
176 (builder2 (add-text-to-store %store "fixed-builder2.sh"
177 "echo hey; echo -n hello > $out" '()))
178 (hash (sha256 (string->utf8 "hello")))
179 (drv-path1 (derivation %store "fixed" (%current-system)
182 #:hash hash #:hash-algo 'sha256))
183 (drv-path2 (derivation %store "fixed" (%current-system)
186 #:hash hash #:hash-algo 'sha256))
187 (succeeded? (build-derivations %store
188 (list drv-path1 drv-path2))))
190 (equal? (derivation-path->output-path drv-path1)
191 (derivation-path->output-path drv-path2)))))
193 (test-assert "derivation with a fixed-output input"
194 ;; A derivation D using a fixed-output derivation F doesn't has the same
195 ;; output path when passed F or F', as long as F and F' have the same output
197 (let* ((builder1 (add-text-to-store %store "fixed-builder1.sh"
198 "echo -n hello > $out" '()))
199 (builder2 (add-text-to-store %store "fixed-builder2.sh"
200 "echo hey; echo -n hello > $out" '()))
201 (hash (sha256 (string->utf8 "hello")))
202 (fixed1 (derivation %store "fixed" (%current-system)
205 #:hash hash #:hash-algo 'sha256))
206 (fixed2 (derivation %store "fixed" (%current-system)
209 #:hash hash #:hash-algo 'sha256))
210 (fixed-out (derivation-path->output-path fixed1))
211 (builder3 (add-text-to-store
212 %store "final-builder.sh"
213 ;; Use Bash hackery to avoid Coreutils.
214 "echo $in ; (read -u 3 c; echo $c) 3< $in > $out" '()))
215 (final1 (derivation %store "final" (%current-system)
217 `(("in" . ,fixed-out))
218 `((,builder3) (,fixed1))))
219 (final2 (derivation %store "final" (%current-system)
221 `(("in" . ,fixed-out))
222 `((,builder3) (,fixed2))))
223 (succeeded? (build-derivations %store
224 (list final1 final2))))
226 (equal? (derivation-path->output-path final1)
227 (derivation-path->output-path final2)))))
229 (test-assert "multiple-output derivation"
230 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
231 "echo one > $out ; echo two > $second"
233 (drv-path (derivation %store "fixed" (%current-system)
235 '(("HOME" . "/homeless")
239 #:outputs '("out" "second")))
240 (succeeded? (build-derivations %store (list drv-path))))
242 (let ((one (derivation-path->output-path drv-path "out"))
243 (two (derivation-path->output-path drv-path "second")))
245 (derivation-path->output-paths drv-path)
246 `(("out" . ,one) ("second" . ,two)))
247 (eq? 'one (call-with-input-file one read))
248 (eq? 'two (call-with-input-file two read)))))))
250 (test-assert "multiple-output derivation, non-alphabetic order"
251 ;; Here, the outputs are not listed in alphabetic order. Yet, the store
252 ;; path computation must reorder them first.
253 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
254 "echo one > $out ; echo two > $AAA"
256 (drv-path (derivation %store "fixed" (%current-system)
260 #:outputs '("out" "AAA")))
261 (succeeded? (build-derivations %store (list drv-path))))
263 (let ((one (derivation-path->output-path drv-path "out"))
264 (two (derivation-path->output-path drv-path "AAA")))
265 (and (eq? 'one (call-with-input-file one read))
266 (eq? 'two (call-with-input-file two read)))))))
268 (test-assert "user of multiple-output derivation"
269 ;; Check whether specifying several inputs coming from the same
270 ;; multiple-output derivation works.
271 (let* ((builder1 (add-text-to-store %store "my-mo-builder.sh"
272 "echo one > $out ; echo two > $two"
274 (mdrv (derivation %store "multiple-output" (%current-system)
278 #:outputs '("out" "two")))
279 (builder2 (add-text-to-store %store "my-mo-user-builder.sh"
282 echo \"($x $y)\" > $out"
284 (udrv (derivation %store "multiple-output-user"
287 `(("one" . ,(derivation-path->output-path
289 ("two" . ,(derivation-path->output-path
292 ;; two occurrences of MDRV:
295 (and (build-derivations %store (list (pk 'udrv udrv)))
296 (let ((p (derivation-path->output-path udrv)))
297 (and (valid-path? %store p)
298 (equal? '(one two) (call-with-input-file p read)))))))
303 (and (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)
304 (or (package-derivation %store %bootstrap-coreutils&co)
305 (nixpkgs-derivation "coreutils")))))
307 (test-skip (if %coreutils 0 1))
309 (test-assert "build derivation with coreutils"
311 (add-text-to-store %store "build-with-coreutils.sh"
312 "echo $PATH ; mkdir --version ; mkdir $out ; touch $out/good"
315 (derivation %store "foo" (%current-system)
319 (derivation-path->output-path %coreutils)
324 (build-derivations %store (list drv-path))))
326 (let ((p (derivation-path->output-path drv-path)))
327 (and (valid-path? %store p)
328 (file-exists? (string-append p "/good")))))))
330 (test-skip (if (%guile-for-build) 0 7))
332 (test-assert "build-expression->derivation and derivation-prerequisites"
333 (let-values (((drv-path drv)
334 (build-expression->derivation %store "fail" (%current-system)
337 (($ <derivation-input> path)
338 (string=? path (%guile-for-build))))
339 (derivation-prerequisites drv))))
341 (test-assert "build-expression->derivation without inputs"
342 (let* ((builder '(begin
344 (call-with-output-file (string-append %output "/test")
346 (display '(hello guix) p)))))
347 (drv-path (build-expression->derivation %store "goo" (%current-system)
349 (succeeded? (build-derivations %store (list drv-path))))
351 (let ((p (derivation-path->output-path drv-path)))
352 (equal? '(hello guix)
353 (call-with-input-file (string-append p "/test") read))))))
355 (test-assert "build-expression->derivation and derivation-prerequisites-to-build"
356 (let-values (((drv-path drv)
357 (build-expression->derivation %store "fail" (%current-system)
359 ;; The only direct dependency is (%guile-for-build) and it's already
361 (null? (derivation-prerequisites-to-build %store drv))))
363 (test-assert "build-expression->derivation with expression returning #f"
364 (let* ((builder '(begin
367 (drv-path (build-expression->derivation %store "fail" (%current-system)
369 (out-path (derivation-path->output-path drv-path)))
370 (guard (c ((nix-protocol-error? c)
371 ;; Note that the output path may exist at this point, but it
373 (and (string-match "build .* failed"
374 (nix-protocol-error-message c))
375 (not (valid-path? %store out-path)))))
376 (build-derivations %store (list drv-path))
379 (test-assert "build-expression->derivation with two outputs"
380 (let* ((builder '(begin
381 (call-with-output-file (assoc-ref %outputs "out")
383 (display '(hello) p)))
384 (call-with-output-file (assoc-ref %outputs "second")
386 (display '(world) p)))))
387 (drv-path (build-expression->derivation %store "double"
392 (succeeded? (build-derivations %store (list drv-path))))
394 (let ((one (derivation-path->output-path drv-path))
395 (two (derivation-path->output-path drv-path "second")))
396 (and (equal? '(hello) (call-with-input-file one read))
397 (equal? '(world) (call-with-input-file two read)))))))
399 (test-skip (if %coreutils 0 1))
400 (test-assert "build-expression->derivation with one input"
401 (let* ((builder '(call-with-output-file %output
403 (let ((cu (assoc-ref %build-inputs "cu")))
405 (dup2 (port->fdes p) 1)
406 (execl (string-append cu "/bin/uname")
408 (drv-path (build-expression->derivation %store "uname" (%current-system)
410 `(("cu" ,%coreutils))))
411 (succeeded? (build-derivations %store (list drv-path))))
413 (let ((p (derivation-path->output-path drv-path)))
414 (string-contains (call-with-input-file p read-line) "GNU")))))
416 (test-assert "imported-files"
417 (let* ((files `(("x" . ,(search-path %load-path "ice-9/q.scm"))
418 ("a/b/c" . ,(search-path %load-path
419 "guix/derivations.scm"))
420 ("p/q" . ,(search-path %load-path "guix.scm"))
421 ("p/z" . ,(search-path %load-path "guix/store.scm"))))
422 (drv-path (imported-files %store files)))
423 (and (build-derivations %store (list drv-path))
424 (let ((dir (derivation-path->output-path drv-path)))
427 (equal? (call-with-input-file (string-append dir "/" path)
429 (call-with-input-file source
430 get-bytevector-all))))
433 (test-assert "build-expression->derivation with modules"
434 (let* ((builder `(begin
435 (use-modules (guix build utils))
436 (let ((out (assoc-ref %outputs "out")))
437 (mkdir-p (string-append out "/guile/guix/nix"))
439 (drv-path (build-expression->derivation %store
444 '((guix build utils)))))
445 (and (build-derivations %store (list drv-path))
446 (let* ((p (derivation-path->output-path drv-path))
447 (s (stat (string-append p "/guile/guix/nix"))))
448 (eq? (stat:type s) 'directory)))))
450 (test-assert "build-expression->derivation: same fixed-output path"
451 (let* ((builder1 '(call-with-output-file %output
454 (builder2 '(call-with-output-file (pk 'difference-here! %output)
457 (hash (sha256 (string->utf8 "hello")))
458 (input1 (build-expression->derivation %store "fixed"
462 #:hash-algo 'sha256))
463 (input2 (build-expression->derivation %store "fixed"
467 #:hash-algo 'sha256))
468 (succeeded? (build-derivations %store (list input1 input2))))
470 (not (string=? input1 input2))
471 (string=? (derivation-path->output-path input1)
472 (derivation-path->output-path input2)))))
474 (test-assert "build-expression->derivation with a fixed-output input"
475 (let* ((builder1 '(call-with-output-file %output
478 (builder2 '(call-with-output-file (pk 'difference-here! %output)
481 (hash (sha256 (string->utf8 "hello")))
482 (input1 (build-expression->derivation %store "fixed"
486 #:hash-algo 'sha256))
487 (input2 (build-expression->derivation %store "fixed"
491 #:hash-algo 'sha256))
492 (builder3 '(let ((input (assoc-ref %build-inputs "input")))
493 (call-with-output-file %output
495 (format #f "My input is ~a.~%" input)))))
496 (final1 (build-expression->derivation %store "final"
499 `(("input" ,input1))))
500 (final2 (build-expression->derivation %store "final"
503 `(("input" ,input2)))))
504 (and (string=? (derivation-path->output-path final1)
505 (derivation-path->output-path final2))
506 (build-derivations %store (list final1 final2)))))
511 (exit (= (test-runner-fail-count (test-runner-current)) 0))
514 ;;; eval: (put 'test-assert 'scheme-indent-function 1)
515 ;;; eval: (put 'guard 'scheme-indent-function 1)