file-systems: Add helpers for parsing the options string into an alist.
[jackhill/guix/guix.git] / tests / profiles.scm
CommitLineData
a2078770 1;;; GNU Guix --- Functional package management for GNU
ef674a24 2;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
343745c8 3;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
a2078770
LC
4;;;
5;;; This file is part of GNU Guix.
6;;;
7;;; GNU Guix is free software; you can redistribute it and/or modify it
8;;; under the terms of the GNU General Public License as published by
9;;; the Free Software Foundation; either version 3 of the License, or (at
10;;; your option) any later version.
11;;;
12;;; GNU Guix is distributed in the hope that it will be useful, but
13;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;;; GNU General Public License for more details.
16;;;
17;;; You should have received a copy of the GNU General Public License
18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19
20(define-module (test-profiles)
c1bc358f 21 #:use-module (guix tests)
a2078770 22 #:use-module (guix profiles)
2225d56a 23 #:use-module (guix gexp)
462f5cca
LC
24 #:use-module (guix store)
25 #:use-module (guix monads)
ef8de985 26 #:use-module (guix grafts)
462f5cca
LC
27 #:use-module (guix packages)
28 #:use-module (guix derivations)
a0dac7a0 29 #:use-module (guix build-system trivial)
462f5cca 30 #:use-module (gnu packages bootstrap)
e39d1461 31 #:use-module ((gnu packages base) #:prefix packages:)
dedb17ad 32 #:use-module ((gnu packages guile) #:prefix packages:)
a2078770 33 #:use-module (ice-9 match)
ef8993e2 34 #:use-module (ice-9 regex)
d664f1b4
LC
35 #:use-module (ice-9 popen)
36 #:use-module (rnrs io ports)
ccda8f7d 37 #:use-module (srfi srfi-1)
79601521 38 #:use-module (srfi srfi-11)
a654dc4b 39 #:use-module (srfi srfi-34)
a2078770
LC
40 #:use-module (srfi srfi-64))
41
343745c8 42;; Test the (guix profiles) module.
a2078770 43
462f5cca 44(define %store
c1bc358f 45 (open-connection-for-tests))
a2078770 46
ef8de985
LC
47;; Globally disable grafts because they can trigger early builds.
48(%graft? #f)
49
a2078770
LC
50;; Example manifest entries.
51
f7554030
AK
52(define guile-1.8.8
53 (manifest-entry
54 (name "guile")
55 (version "1.8.8")
56 (item "/gnu/store/...")
57 (output "out")))
58
a2078770
LC
59(define guile-2.0.9
60 (manifest-entry
61 (name "guile")
62 (version "2.0.9")
a54c94a4 63 (item "/gnu/store/...")
a2078770
LC
64 (output "out")))
65
66(define guile-2.0.9:debug
67 (manifest-entry (inherit guile-2.0.9)
68 (output "debug")))
69
79601521
LC
70(define glibc
71 (manifest-entry
72 (name "glibc")
73 (version "2.19")
74 (item "/gnu/store/...")
75 (output "out")))
76
a2078770
LC
77\f
78(test-begin "profiles")
79
80(test-assert "manifest-installed?"
81 (let ((m (manifest (list guile-2.0.9 guile-2.0.9:debug))))
82 (and (manifest-installed? m (manifest-pattern (name "guile")))
83 (manifest-installed? m (manifest-pattern
84 (name "guile") (output "debug")))
85 (manifest-installed? m (manifest-pattern
86 (name "guile") (output "out")
87 (version "2.0.9")))
88 (not (manifest-installed?
89 m (manifest-pattern (name "guile") (version "1.8.8"))))
90 (not (manifest-installed?
91 m (manifest-pattern (name "guile") (output "foobar")))))))
92
93(test-assert "manifest-matching-entries"
94 (let* ((e (list guile-2.0.9 guile-2.0.9:debug))
95 (m (manifest e)))
487cbb01 96 (and (equal? e
a2078770
LC
97 (manifest-matching-entries m
98 (list (manifest-pattern
99 (name "guile")
100 (output #f)))))
101 (equal? (list guile-2.0.9)
102 (manifest-matching-entries m
103 (list (manifest-pattern
104 (name "guile")
105 (version "2.0.9"))))))))
106
487cbb01
LC
107(test-assert "manifest-matching-entries, no match"
108 (let ((m (manifest (list guile-2.0.9)))
109 (p (manifest-pattern (name "python"))))
110 (guard (c ((unmatched-pattern-error? c)
111 (and (eq? p (unmatched-pattern-error-pattern c))
112 (eq? m (unmatched-pattern-error-manifest c)))))
113 (manifest-matching-entries m (list p))
114 #f)))
115
ce30a0eb
LC
116(test-equal "concatenate-manifests"
117 (manifest (list guile-2.0.9 glibc))
118 (concatenate-manifests (list (manifest (list guile-2.0.9))
119 (manifest (list glibc)))))
120
a2078770
LC
121(test-assert "manifest-remove"
122 (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug)))
123 (m1 (manifest-remove m0
124 (list (manifest-pattern (name "guile")))))
125 (m2 (manifest-remove m1
126 (list (manifest-pattern (name "guile"))))) ; same
127 (m3 (manifest-remove m2
128 (list (manifest-pattern
129 (name "guile") (output "debug")))))
130 (m4 (manifest-remove m3
131 (list (manifest-pattern (name "guile"))))))
132 (match (manifest-entries m2)
133 ((($ <manifest-entry> "guile" "2.0.9" "debug"))
134 (and (equal? m1 m2)
135 (null? (manifest-entries m3))
136 (null? (manifest-entries m4)))))))
137
f7554030
AK
138(test-assert "manifest-add"
139 (let* ((m0 (manifest '()))
140 (m1 (manifest-add m0 (list guile-1.8.8)))
141 (m2 (manifest-add m1 (list guile-2.0.9)))
142 (m3 (manifest-add m2 (list guile-2.0.9:debug)))
143 (m4 (manifest-add m3 (list guile-2.0.9:debug))))
144 (and (match (manifest-entries m1)
145 ((($ <manifest-entry> "guile" "1.8.8" "out")) #t)
146 (_ #f))
147 (match (manifest-entries m2)
148 ((($ <manifest-entry> "guile" "2.0.9" "out")) #t)
149 (_ #f))
150 (equal? m3 m4))))
151
435603a1
LC
152(test-equal "manifest-add removes duplicates" ;<https://bugs.gnu.org/30569>
153 (list guile-2.0.9)
154 (manifest-entries (manifest-add (manifest '())
155 (list guile-2.0.9 guile-2.0.9))))
156
343745c8
AK
157(test-assert "manifest-perform-transaction"
158 (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug)))
159 (t1 (manifest-transaction
160 (install (list guile-1.8.8))
161 (remove (list (manifest-pattern (name "guile")
162 (output "debug"))))))
163 (t2 (manifest-transaction
164 (remove (list (manifest-pattern (name "guile")
165 (version "2.0.9")
166 (output #f))))))
167 (m1 (manifest-perform-transaction m0 t1))
168 (m2 (manifest-perform-transaction m1 t2))
169 (m3 (manifest-perform-transaction m0 t2)))
170 (and (match (manifest-entries m1)
171 ((($ <manifest-entry> "guile" "1.8.8" "out")) #t)
172 (_ #f))
173 (equal? m1 m2)
174 (null? (manifest-entries m3)))))
175
79601521
LC
176(test-assert "manifest-transaction-effects"
177 (let* ((m0 (manifest (list guile-1.8.8)))
178 (t (manifest-transaction
487cbb01 179 (install (list guile-2.0.9 glibc)))))
46b23e1a 180 (let-values (((remove install upgrade downgrade)
79601521 181 (manifest-transaction-effects m0 t)))
46b23e1a 182 (and (null? remove) (null? downgrade)
79601521 183 (equal? (list glibc) install)
ef8993e2
LC
184 (equal? (list (cons guile-1.8.8 guile-2.0.9)) upgrade)))))
185
46b23e1a
LC
186(test-assert "manifest-transaction-effects and downgrades"
187 (let* ((m0 (manifest (list guile-2.0.9)))
188 (t (manifest-transaction (install (list guile-1.8.8)))))
189 (let-values (((remove install upgrade downgrade)
190 (manifest-transaction-effects m0 t)))
191 (and (null? remove) (null? install) (null? upgrade)
192 (equal? (list (cons guile-2.0.9 guile-1.8.8)) downgrade)))))
193
3bea13bb
LC
194(test-assert "manifest-transaction-effects and pseudo-upgrades"
195 (let* ((m0 (manifest (list guile-2.0.9)))
196 (t (manifest-transaction (install (list guile-2.0.9)))))
197 (let-values (((remove install upgrade downgrade)
198 (manifest-transaction-effects m0 t)))
199 (and (null? remove) (null? install) (null? downgrade)
200 (equal? (list (cons guile-2.0.9 guile-2.0.9)) upgrade)))))
201
c8c25704
LC
202(test-assert "manifest-transaction-null?"
203 (manifest-transaction-null? (manifest-transaction)))
204
6d382339
LC
205(test-assert "manifest-transaction-removal-candidate?"
206 (let ((m (manifest (list guile-2.0.9)))
207 (t (manifest-transaction
208 (remove (list (manifest-pattern (name "guile")))))))
209 (and (manifest-transaction-removal-candidate? guile-2.0.9 t)
210 (not (manifest-transaction-removal-candidate? glibc t)))))
211
ebf5ad46
LC
212(test-assertm "profile-derivation"
213 (mlet* %store-monad
214 ((entry -> (package->manifest-entry %bootstrap-guile))
215 (guile (package->derivation %bootstrap-guile))
216 (drv (profile-derivation (manifest (list entry))
a6562c7e
LC
217 #:hooks '()
218 #:locales? #f))
ebf5ad46
LC
219 (profile -> (derivation->output-path drv))
220 (bindir -> (string-append profile "/bin"))
221 (_ (built-derivations (list drv))))
222 (return (and (file-exists? (string-append bindir "/guile"))
223 (string=? (dirname (readlink bindir))
224 (derivation->output-path guile))))))
462f5cca 225
ef674a24
LC
226(test-assertm "<profile>"
227 (mlet* %store-monad
228 ((entry -> (package->manifest-entry %bootstrap-guile))
229 (profile -> (profile (hooks '()) (locales? #f)
230 (content (manifest (list entry)))))
231 (drv (lower-object profile))
232 (profile -> (derivation->output-path drv))
233 (bindir -> (string-append profile "/bin"))
234 (_ (built-derivations (list drv))))
235 (return (file-exists? (string-append bindir "/guile")))))
236
e00ade3f
LC
237(test-assertm "profile-derivation relative symlinks, one entry"
238 (mlet* %store-monad
239 ((entry -> (package->manifest-entry %bootstrap-guile))
240 (guile (package->derivation %bootstrap-guile))
241 (drv (profile-derivation (manifest (list entry))
242 #:relative-symlinks? #t
243 #:hooks '()
244 #:locales? #f))
245 (profile -> (derivation->output-path drv))
246 (bindir -> (string-append profile "/bin"))
247 (_ (built-derivations (list drv))))
248 (return (and (file-exists? (string-append bindir "/guile"))
249 (string=? (readlink bindir)
250 (string-append "../"
251 (basename
252 (derivation->output-path guile))
253 "/bin"))))))
254
255(unless (network-reachable?) (test-skip 1))
256(test-assertm "profile-derivation relative symlinks, two entries"
257 (mlet* %store-monad
03d76577
LC
258 ((manifest -> (packages->manifest
259 (list %bootstrap-guile gnu-make-for-tests)))
e00ade3f 260 (guile (package->derivation %bootstrap-guile))
03d76577 261 (make (package->derivation gnu-make-for-tests))
e00ade3f
LC
262 (drv (profile-derivation manifest
263 #:relative-symlinks? #t
264 #:hooks '()
265 #:locales? #f))
266 (profile -> (derivation->output-path drv))
267 (bindir -> (string-append profile "/bin"))
268 (_ (built-derivations (list drv))))
269 (return (and (file-exists? (string-append bindir "/guile"))
270 (file-exists? (string-append bindir "/make"))
271 (string=? (readlink (string-append bindir "/guile"))
272 (string-append "../../"
273 (basename
274 (derivation->output-path guile))
275 "/bin/guile"))
276 (string=? (readlink (string-append bindir "/make"))
277 (string-append "../../"
278 (basename
279 (derivation->output-path make))
280 "/bin/make"))))))
281
e39d1461
LC
282(test-assertm "profile-derivation, inputs"
283 (mlet* %store-monad
284 ((entry -> (package->manifest-entry packages:glibc "debug"))
285 (drv (profile-derivation (manifest (list entry))
a6562c7e
LC
286 #:hooks '()
287 #:locales? #f)))
e39d1461
LC
288 (return (derivation-inputs drv))))
289
176febe3
LC
290(test-assertm "profile-derivation, cross-compilation"
291 (mlet* %store-monad
292 ((manifest -> (packages->manifest (list packages:sed packages:grep)))
293 (target -> "arm-linux-gnueabihf")
294 (grep (package->cross-derivation packages:grep target))
295 (sed (package->cross-derivation packages:sed target))
296 (locales (package->derivation packages:glibc-utf8-locales))
297 (drv (profile-derivation manifest
298 #:hooks '()
299 #:locales? #t
300 #:target target)))
ede121de
CM
301 (define (find-input package)
302 (let ((name (string-append (package-full-name package "-") ".drv")))
176febe3
LC
303 (any (lambda (input)
304 (let ((input (derivation-input-path input)))
305 (and (string-suffix? name input) input)))
306 (derivation-inputs drv))))
307
308 ;; The inputs for grep and sed should be cross-build derivations, but that
309 ;; for the glibc-utf8-locales should be a native build.
310 (return (and (string=? (derivation-system drv) (%current-system))
ede121de 311 (string=? (find-input packages:grep)
176febe3 312 (derivation-file-name grep))
ede121de 313 (string=? (find-input packages:sed)
176febe3 314 (derivation-file-name sed))
ede121de 315 (string=? (find-input packages:glibc-utf8-locales)
176febe3
LC
316 (derivation-file-name locales))))))
317
9e90fc77
LC
318(test-assert "package->manifest-entry defaults to \"out\""
319 (let ((outputs (package-outputs packages:glibc)))
320 (equal? (manifest-entry-output
321 (package->manifest-entry (package
322 (inherit packages:glibc)
323 (outputs (reverse outputs)))))
324 (manifest-entry-output
325 (package->manifest-entry packages:glibc))
326 "out")))
327
dedb17ad
LC
328(test-assertm "profile-manifest, search-paths"
329 (mlet* %store-monad
330 ((guile -> (package
331 (inherit %bootstrap-guile)
332 (native-search-paths
333 (package-native-search-paths packages:guile-2.0))))
334 (entry -> (package->manifest-entry guile))
335 (drv (profile-derivation (manifest (list entry))
a6562c7e
LC
336 #:hooks '()
337 #:locales? #f))
dedb17ad
LC
338 (profile -> (derivation->output-path drv)))
339 (mbegin %store-monad
340 (built-derivations (list drv))
341
342 ;; Read the manifest back and make sure search paths are preserved.
343 (let ((manifest (profile-manifest profile)))
344 (match (manifest-entries manifest)
345 ((result)
346 (return (equal? (manifest-entry-search-paths result)
347 (manifest-entry-search-paths entry)
348 (package-native-search-paths
349 packages:guile-2.0)))))))))
d664f1b4 350
ccda8f7d
LC
351(test-assert "package->manifest-entry, search paths"
352 ;; See <http://bugs.gnu.org/22073>.
2d17a904 353 (let ((mpl (@ (gnu packages python-xyz) python2-matplotlib)))
ccda8f7d
LC
354 (lset= eq?
355 (package-transitive-native-search-paths mpl)
356 (manifest-entry-search-paths
357 (package->manifest-entry mpl)))))
358
55b4715f
LC
359(test-equal "packages->manifest, propagated inputs"
360 (map (match-lambda
361 ((label package)
362 (list (package-name package) (package-version package)
363 package)))
364 (package-propagated-inputs packages:guile-2.2))
365 (map (lambda (entry)
366 (list (manifest-entry-name entry)
367 (manifest-entry-version entry)
368 (manifest-entry-item entry)))
369 (manifest-entry-dependencies
370 (package->manifest-entry packages:guile-2.2))))
371
b3a00885
LC
372(test-assert "manifest-entry-parent"
373 (let ((entry (package->manifest-entry packages:guile-2.2)))
374 (match (manifest-entry-dependencies entry)
375 ((dependencies ..1)
376 (and (every (lambda (parent)
377 (eq? entry (force parent)))
378 (map manifest-entry-parent dependencies))
379 (not (force (manifest-entry-parent entry))))))))
380
55b4715f
LC
381(test-assertm "read-manifest"
382 (mlet* %store-monad ((manifest -> (packages->manifest
383 (list (package
384 (inherit %bootstrap-guile)
385 (native-search-paths
386 (package-native-search-paths
387 packages:guile-2.0))))))
388 (drv (profile-derivation manifest
389 #:hooks '()
390 #:locales? #f))
391 (out -> (derivation->output-path drv)))
392 (define (entry->sexp entry)
393 (list (manifest-entry-name entry)
394 (manifest-entry-version entry)
395 (manifest-entry-search-paths entry)
b3a00885
LC
396 (manifest-entry-dependencies entry)
397 (force (manifest-entry-parent entry))))
55b4715f
LC
398
399 (mbegin %store-monad
400 (built-derivations (list drv))
401 (let ((manifest2 (profile-manifest out)))
402 (return (equal? (map entry->sexp (manifest-entries manifest))
403 (map entry->sexp (manifest-entries manifest2))))))))
404
a654dc4b
LC
405(test-equal "collision"
406 '(("guile-bootstrap" "2.0") ("guile-bootstrap" "42"))
407 (guard (c ((profile-collision-error? c)
408 (let ((entry1 (profile-collision-error-entry c))
409 (entry2 (profile-collision-error-conflict c)))
410 (list (list (manifest-entry-name entry1)
411 (manifest-entry-version entry1))
412 (list (manifest-entry-name entry2)
413 (manifest-entry-version entry2))))))
414 (run-with-store %store
415 (mlet* %store-monad ((p0 -> (package
416 (inherit %bootstrap-guile)
417 (version "42")))
418 (p1 -> (dummy-package "p1"
419 (propagated-inputs `(("p0" ,p0)))))
420 (manifest -> (packages->manifest
421 (list %bootstrap-guile p1)))
422 (drv (profile-derivation manifest
423 #:hooks '()
424 #:locales? #f)))
425 (return #f)))))
426
427(test-equal "collision of propagated inputs"
428 '(("guile-bootstrap" "2.0") ("guile-bootstrap" "42"))
429 (guard (c ((profile-collision-error? c)
430 (let ((entry1 (profile-collision-error-entry c))
431 (entry2 (profile-collision-error-conflict c)))
432 (list (list (manifest-entry-name entry1)
433 (manifest-entry-version entry1))
434 (list (manifest-entry-name entry2)
435 (manifest-entry-version entry2))))))
436 (run-with-store %store
437 (mlet* %store-monad ((p0 -> (package
438 (inherit %bootstrap-guile)
439 (version "42")))
440 (p1 -> (dummy-package "p1"
441 (propagated-inputs
442 `(("guile" ,%bootstrap-guile)))))
443 (p2 -> (dummy-package "p2"
444 (propagated-inputs
445 `(("guile" ,p0)))))
446 (manifest -> (packages->manifest (list p1 p2)))
447 (drv (profile-derivation manifest
448 #:hooks '()
449 #:locales? #f)))
450 (return #f)))))
451
452(test-assertm "no collision"
453 ;; Here we have an entry that is "lowered" (its 'item' field is a store file
454 ;; name) and another entry (its 'item' field is a package) that is
455 ;; equivalent.
456 (mlet* %store-monad ((p -> (dummy-package "p"
457 (propagated-inputs
458 `(("guile" ,%bootstrap-guile)))))
459 (guile (package->derivation %bootstrap-guile))
460 (entry -> (manifest-entry
461 (inherit (package->manifest-entry
462 %bootstrap-guile))
463 (item (derivation->output-path guile))))
464 (manifest -> (manifest
465 (list entry
466 (package->manifest-entry p))))
467 (drv (profile-derivation manifest)))
468 (return (->bool drv))))
469
d664f1b4
LC
470(test-assertm "etc/profile"
471 ;; Make sure we get an 'etc/profile' file that at least defines $PATH.
472 (mlet* %store-monad
473 ((guile -> (package
474 (inherit %bootstrap-guile)
475 (native-search-paths
476 (package-native-search-paths packages:guile-2.0))))
477 (entry -> (package->manifest-entry guile))
478 (drv (profile-derivation (manifest (list entry))
a6562c7e
LC
479 #:hooks '()
480 #:locales? #f))
d664f1b4
LC
481 (profile -> (derivation->output-path drv)))
482 (mbegin %store-monad
483 (built-derivations (list drv))
484 (let* ((pipe (open-input-pipe
9e006fb3
TUBK
485 (string-append "unset GUIX_PROFILE; "
486 ;; 'source' is a Bashism; use '.' (dot).
487 ". " profile "/etc/profile; "
488 ;; Don't try to parse set(1) output because
489 ;; it differs among shells; just use echo.
490 "echo $PATH")))
491 (path (get-string-all pipe)))
d664f1b4
LC
492 (return
493 (and (zero? (close-pipe pipe))
9e006fb3 494 (string-contains path (string-append profile "/bin"))))))))
d664f1b4 495
a0dac7a0
LC
496(test-assertm "etc/profile when etc/ already exists"
497 ;; Here 'union-build' makes the profile's etc/ a symlink to the package's
498 ;; etc/ directory, which makes it read-only. Make sure the profile build
499 ;; handles that.
500 (mlet* %store-monad
501 ((thing -> (dummy-package "dummy"
502 (build-system trivial-build-system)
503 (arguments
504 `(#:guile ,%bootstrap-guile
505 #:builder
506 (let ((out (assoc-ref %outputs "out")))
507 (mkdir out)
508 (mkdir (string-append out "/etc"))
509 (call-with-output-file (string-append out "/etc/foo")
510 (lambda (port)
1e868858
MW
511 (display "foo!" port)))
512 #t)))))
a0dac7a0
LC
513 (entry -> (package->manifest-entry thing))
514 (drv (profile-derivation (manifest (list entry))
a6562c7e
LC
515 #:hooks '()
516 #:locales? #f))
a0dac7a0
LC
517 (profile -> (derivation->output-path drv)))
518 (mbegin %store-monad
519 (built-derivations (list drv))
520 (return (and (file-exists? (string-append profile "/etc/profile"))
521 (string=? (call-with-input-file
522 (string-append profile "/etc/foo")
523 get-string-all)
524 "foo!"))))))
525
113c17a0
LC
526(test-assertm "etc/profile when etc/ is a symlink"
527 ;; When etc/ is a symlink, the unsymlink code in 0.8.2 would fail
528 ;; gracelessly because 'scandir' would return #f.
529 (mlet* %store-monad
530 ((thing -> (dummy-package "dummy"
531 (build-system trivial-build-system)
532 (arguments
533 `(#:guile ,%bootstrap-guile
534 #:builder
535 (let ((out (assoc-ref %outputs "out")))
536 (mkdir out)
537 (mkdir (string-append out "/foo"))
538 (symlink "foo" (string-append out "/etc"))
539 (call-with-output-file (string-append out "/etc/bar")
540 (lambda (port)
1e868858
MW
541 (display "foo!" port)))
542 #t)))))
113c17a0
LC
543 (entry -> (package->manifest-entry thing))
544 (drv (profile-derivation (manifest (list entry))
a6562c7e
LC
545 #:hooks '()
546 #:locales? #f))
113c17a0
LC
547 (profile -> (derivation->output-path drv)))
548 (mbegin %store-monad
549 (built-derivations (list drv))
550 (return (and (file-exists? (string-append profile "/etc/profile"))
551 (string=? (call-with-input-file
552 (string-append profile "/etc/bar")
553 get-string-all)
554 "foo!"))))))
555
2225d56a
LC
556(test-assertm "profile-derivation when etc/ is a relative symlink"
557 ;; See <https://bugs.gnu.org/32686>.
558 (mlet* %store-monad
559 ((etc (gexp->derivation
560 "etc"
561 #~(begin
562 (mkdir #$output)
563 (call-with-output-file (string-append #$output "/foo")
564 (lambda (port)
565 (display "Heya!" port))))))
566 (thing -> (dummy-package "dummy"
567 (build-system trivial-build-system)
568 (inputs
569 `(("etc" ,etc)))
570 (arguments
571 `(#:guile ,%bootstrap-guile
572 #:builder
573 (let ((out (assoc-ref %outputs "out"))
574 (etc (assoc-ref %build-inputs "etc")))
575 (mkdir out)
576 (symlink etc (string-append out "/etc"))
577 #t)))))
578 (entry -> (package->manifest-entry thing))
579 (drv (profile-derivation (manifest (list entry))
580 #:relative-symlinks? #t
581 #:hooks '()
582 #:locales? #f))
583 (profile -> (derivation->output-path drv)))
584 (mbegin %store-monad
585 (built-derivations (list drv))
586 (return (string=? (call-with-input-file
587 (string-append profile "/etc/foo")
588 get-string-all)
589 "Heya!")))))
590
22ef06b8
LC
591(test-equalm "union vs. dangling symlink" ;<https://bugs.gnu.org/26949>
592 "does-not-exist"
593 (mlet* %store-monad
594 ((thing1 -> (dummy-package "dummy"
595 (build-system trivial-build-system)
596 (arguments
597 `(#:guile ,%bootstrap-guile
598 #:builder
599 (let ((out (assoc-ref %outputs "out")))
600 (mkdir out)
601 (symlink "does-not-exist"
602 (string-append out "/dangling"))
603 #t)))))
604 (thing2 -> (package (inherit thing1) (name "dummy2")))
605 (drv (profile-derivation (packages->manifest
606 (list thing1 thing2))
607 #:hooks '()
608 #:locales? #f))
609 (profile -> (derivation->output-path drv)))
610 (mbegin %store-monad
611 (built-derivations (list drv))
612 (return (readlink (readlink (string-append profile "/dangling")))))))
613
38b77f34
LC
614(test-equalm "profile in profile"
615 '("foo" "0")
616
617 ;; Make sure we can build a profile that has another profile has one of its
618 ;; entries. The new profile's /manifest and /etc/profile must override the
619 ;; other's.
620 (mlet* %store-monad
621 ((prof0 (profile-derivation
622 (manifest
623 (list (package->manifest-entry %bootstrap-guile)))
624 #:hooks '()
625 #:locales? #f))
626 (prof1 (profile-derivation
627 (manifest (list (manifest-entry
628 (name "foo")
629 (version "0")
630 (item prof0))))
631 #:hooks '()
632 #:locales? #f)))
633 (mbegin %store-monad
634 (built-derivations (list prof1))
635 (let ((out (derivation->output-path prof1)))
636 (return (and (file-exists?
637 (string-append out "/bin/guile"))
638 (let ((manifest (profile-manifest out)))
639 (match (manifest-entries manifest)
640 ((entry)
641 (list (manifest-entry-name entry)
642 (manifest-entry-version entry)))))))))))
643
a2078770
LC
644(test-end "profiles")
645
a2078770
LC
646;;; Local Variables:
647;;; eval: (put 'dummy-package 'scheme-indent-function 1)
648;;; End: