gnu: Add phonon.
[jackhill/guix/guix.git] / tests / store.scm
CommitLineData
233e7676 1;;; GNU Guix --- Functional package management for GNU
0f3d2504 2;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
3259877d 3;;;
233e7676 4;;; This file is part of GNU Guix.
3259877d 5;;;
233e7676 6;;; GNU Guix is free software; you can redistribute it and/or modify it
3259877d
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
3259877d
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/>.
3259877d
LC
18
19
20(define-module (test-store)
21 #:use-module (guix store)
22 #:use-module (guix utils)
72626a71 23 #:use-module (guix hash)
3259877d 24 #:use-module (guix base32)
0f3d2504
LC
25 #:use-module (guix packages)
26 #:use-module (guix derivations)
fe0cff14 27 #:use-module (guix nar)
fae31edc 28 #:use-module (gnu packages)
1ffa7090 29 #:use-module (gnu packages bootstrap)
3259877d 30 #:use-module (ice-9 match)
fe0cff14 31 #:use-module (rnrs io ports)
f65cf81a 32 #:use-module (web uri)
3259877d
LC
33 #:use-module (srfi srfi-1)
34 #:use-module (srfi srfi-11)
c3eb878f 35 #:use-module (srfi srfi-34)
3259877d
LC
36 #:use-module (srfi srfi-64))
37
38;; Test the (guix store) module.
39
40(define %store
41 (false-if-exception (open-connection)))
42
43(when %store
44 ;; Make sure we build everything by ourselves.
45 (set-build-options %store #:use-substitutes? #f))
46
47(define %seed
48 (seed->random-state (logxor (getpid) (car (gettimeofday)))))
49
50(define (random-text)
51 (number->string (random (expt 2 256) %seed) 16))
52
53\f
54(test-begin "store")
55
2c6ab6cc
LC
56(test-equal "store-path-hash-part"
57 "283gqy39v3g9dxjy26rynl0zls82fmcg"
58 (store-path-hash-part
59 (string-append (%store-prefix)
60 "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
61
62(test-equal "store-path-hash-part #f"
63 #f
64 (store-path-hash-part
65 (string-append (%store-prefix)
66 "/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
67
3259877d
LC
68(test-skip (if %store 0 10))
69
70(test-assert "dead-paths"
cfbf9160 71 (let ((p (add-text-to-store %store "random-text" (random-text))))
3259877d
LC
72 (member p (dead-paths %store))))
73
74;; FIXME: Find a test for `live-paths'.
75;;
76;; (test-assert "temporary root is in live-paths"
77;; (let* ((p1 (add-text-to-store %store "random-text"
78;; (random-text) '()))
79;; (b (add-text-to-store %store "link-builder"
80;; (format #f "echo ~a > $out" p1)
81;; '()))
a987d2c0
LC
82;; (d1 (derivation %store "link"
83;; "/bin/sh" `("-e" ,b)
84;; #:inputs `((,b) (,p1))))
59688fc4 85;; (p2 (derivation->output-path d1)))
3259877d
LC
86;; (and (add-temp-root %store p2)
87;; (build-derivations %store (list d1))
88;; (valid-path? %store p1)
89;; (member (pk p2) (live-paths %store)))))
90
91(test-assert "dead path can be explicitly collected"
92 (let ((p (add-text-to-store %store "random-text"
93 (random-text) '())))
94 (let-values (((paths freed) (delete-paths %store (list p))))
95 (and (equal? paths (list p))
96 (> freed 0)
97 (not (file-exists? p))))))
98
fae31edc
LC
99(test-assert "references"
100 (let* ((t1 (add-text-to-store %store "random1"
cfbf9160 101 (random-text)))
fae31edc
LC
102 (t2 (add-text-to-store %store "random2"
103 (random-text) (list t1))))
104 (and (equal? (list t1) (references %store t2))
105 (equal? (list t2) (referrers %store t1))
106 (null? (references %store t1))
107 (null? (referrers %store t2)))))
108
3f1e6939
LC
109(test-assert "requisites"
110 (let* ((t1 (add-text-to-store %store "random1"
111 (random-text) '()))
112 (t2 (add-text-to-store %store "random2"
113 (random-text) (list t1)))
114 (t3 (add-text-to-store %store "random3"
115 (random-text) (list t2)))
116 (t4 (add-text-to-store %store "random4"
117 (random-text) (list t1 t3))))
118 (define (same? x y)
119 (and (= (length x) (length y))
120 (lset= equal? x y)))
121
122 (and (same? (requisites %store t1) (list t1))
123 (same? (requisites %store t2) (list t1 t2))
124 (same? (requisites %store t3) (list t1 t2 t3))
125 (same? (requisites %store t4) (list t1 t2 t3 t4)))))
126
fae31edc
LC
127(test-assert "derivers"
128 (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
129 (s (add-to-store %store "bash" #t "sha256"
130 (search-bootstrap-binary "bash"
131 (%current-system))))
a987d2c0
LC
132 (d (derivation %store "the-thing"
133 s `("-e" ,b)
134 #:env-vars `(("foo" . ,(random-text)))
135 #:inputs `((,b) (,s))))
59688fc4 136 (o (derivation->output-path d)))
fae31edc 137 (and (build-derivations %store (list d))
59688fc4 138 (equal? (query-derivation-outputs %store (derivation-file-name d))
fae31edc
LC
139 (list o))
140 (equal? (valid-derivers %store o)
59688fc4 141 (list (derivation-file-name d))))))
fae31edc 142
0f3d2504
LC
143(test-assert "no substitutes"
144 (let* ((s (open-connection))
145 (d1 (package-derivation s %bootstrap-guile (%current-system)))
146 (d2 (package-derivation s %bootstrap-glibc (%current-system)))
59688fc4 147 (o (map derivation->output-path (list d1 d2))))
0f3d2504 148 (set-build-options s #:use-substitutes? #f)
59688fc4
LC
149 (and (not (has-substitutes? s (derivation-file-name d1)))
150 (not (has-substitutes? s (derivation-file-name d2)))
0f3d2504
LC
151 (null? (substitutable-paths s o))
152 (null? (substitutable-path-info s o)))))
153
f65cf81a
LC
154(test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1))
155
156(test-assert "substitute query"
157 (let* ((s (open-connection))
158 (d (package-derivation s %bootstrap-guile (%current-system)))
59688fc4 159 (o (derivation->output-path d))
f65cf81a
LC
160 (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
161 (compose uri-path string->uri))))
162 ;; Create fake substituter data, to be read by `substitute-binary'.
163 (call-with-output-file (string-append dir "/nix-cache-info")
164 (lambda (p)
165 (format p "StoreDir: ~a\nWantMassQuery: 0\n"
fe0cff14 166 (%store-prefix))))
f65cf81a
LC
167 (call-with-output-file (string-append dir "/" (store-path-hash-part o)
168 ".narinfo")
169 (lambda (p)
170 (format p "StorePath: ~a
171URL: ~a
172Compression: none
173NarSize: 1234
174References:
175System: ~a
176Deriver: ~a~%"
177 o ; StorePath
178 (string-append dir "/example.nar") ; URL
179 (%current-system) ; System
59688fc4
LC
180 (basename
181 (derivation-file-name d))))) ; Deriver
f65cf81a 182
eba783b7
LC
183 ;; Remove entry from the local cache.
184 (false-if-exception
185 (delete-file (string-append (getenv "XDG_CACHE_HOME")
186 "/guix/substitute-binary/"
187 (store-path-hash-part o))))
188
f65cf81a
LC
189 ;; Make sure `substitute-binary' correctly communicates the above data.
190 (set-build-options s #:use-substitutes? #t)
191 (and (has-substitutes? s o)
192 (equal? (list o) (substitutable-paths s (list o)))
193 (match (pk 'spi (substitutable-path-info s (list o)))
194 (((? substitutable? s))
59688fc4 195 (and (string=? (substitutable-deriver s) (derivation-file-name d))
f65cf81a
LC
196 (null? (substitutable-references s))
197 (equal? (substitutable-nar-size s) 1234)))))))
198
fe0cff14
LC
199(test-assert "substitute"
200 (let* ((s (open-connection))
201 (c (random-text)) ; contents of the output
202 (d (build-expression->derivation
203 s "substitute-me" (%current-system)
204 `(call-with-output-file %output
205 (lambda (p)
206 (exit 1) ; would actually fail
207 (display ,c p)))
208 '()
209 #:guile-for-build
210 (package-derivation s %bootstrap-guile (%current-system))))
59688fc4 211 (o (derivation->output-path d))
fe0cff14
LC
212 (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
213 (compose uri-path string->uri))))
214 ;; Create fake substituter data, to be read by `substitute-binary'.
215 (call-with-output-file (string-append dir "/nix-cache-info")
216 (lambda (p)
217 (format p "StoreDir: ~a\nWantMassQuery: 0\n"
218 (%store-prefix))))
219 (call-with-output-file (string-append dir "/example.out")
220 (lambda (p)
221 (display c p)))
222 (call-with-output-file (string-append dir "/example.nar")
223 (lambda (p)
224 (write-file (string-append dir "/example.out") p)))
225 (call-with-output-file (string-append dir "/" (store-path-hash-part o)
226 ".narinfo")
227 (lambda (p)
228 (format p "StorePath: ~a
229URL: ~a
230Compression: none
231NarSize: 1234
232NarHash: sha256:~a
233References:
234System: ~a
235Deriver: ~a~%"
236 o ; StorePath
237 "example.nar" ; relative URL
238 (call-with-input-file (string-append dir "/example.nar")
239 (compose bytevector->nix-base32-string sha256
240 get-bytevector-all))
241 (%current-system) ; System
59688fc4
LC
242 (basename
243 (derivation-file-name d))))) ; Deriver
fe0cff14
LC
244
245 ;; Make sure we use `substitute-binary'.
246 (set-build-options s #:use-substitutes? #t)
247 (and (has-substitutes? s o)
248 (build-derivations s (list d))
249 (equal? c (call-with-input-file o get-string-all)))))
250
c3eb878f
LC
251(test-assert "substitute --fallback"
252 (let* ((s (open-connection))
253 (t (random-text)) ; contents of the output
254 (d (build-expression->derivation
255 s "substitute-me-not" (%current-system)
256 `(call-with-output-file %output
257 (lambda (p)
258 (display ,t p)))
259 '()
260 #:guile-for-build
261 (package-derivation s %bootstrap-guile (%current-system))))
59688fc4 262 (o (derivation->output-path d))
c3eb878f
LC
263 (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
264 (compose uri-path string->uri))))
265 ;; Create fake substituter data, to be read by `substitute-binary'.
266 (call-with-output-file (string-append dir "/nix-cache-info")
267 (lambda (p)
268 (format p "StoreDir: ~a\nWantMassQuery: 0\n"
269 (%store-prefix))))
270 (call-with-output-file (string-append dir "/" (store-path-hash-part o)
271 ".narinfo")
272 (lambda (p)
273 (format p "StorePath: ~a
274URL: ~a
275Compression: none
276NarSize: 1234
277NarHash: sha256:0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73
278References:
279System: ~a
280Deriver: ~a~%"
281 o ; StorePath
282 "does-not-exist.nar" ; relative URL
283 (%current-system) ; System
59688fc4
LC
284 (basename
285 (derivation-file-name d))))) ; Deriver
c3eb878f
LC
286
287 ;; Make sure we use `substitute-binary'.
288 (set-build-options s #:use-substitutes? #t)
289 (and (has-substitutes? s o)
290 (guard (c ((nix-protocol-error? c)
291 ;; The substituter failed as expected. Now make sure that
292 ;; #:fallback? #t works correctly.
293 (set-build-options s
294 #:use-substitutes? #t
295 #:fallback? #t)
296 (and (build-derivations s (list d))
297 (equal? t (call-with-input-file o get-string-all)))))
298 ;; Should fail.
299 (build-derivations s (list d))
300 #f))))
301
3259877d
LC
302(test-end "store")
303
304\f
305(exit (= (test-runner-fail-count (test-runner-current)) 0))