1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
5 ;;; This file is part of GNU Guix.
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.
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.
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/>.
20 (define-module (test-profiles)
21 #:use-module (guix tests)
22 #:use-module (guix profiles)
23 #:use-module (guix gexp)
24 #:use-module (guix store)
25 #:use-module (guix monads)
26 #:use-module (guix packages)
27 #:use-module (guix derivations)
28 #:use-module (guix build-system trivial)
29 #:use-module (gnu packages bootstrap)
30 #:use-module ((gnu packages base) #:prefix packages:)
31 #:use-module ((gnu packages guile) #:prefix packages:)
32 #:use-module (ice-9 match)
33 #:use-module (ice-9 regex)
34 #:use-module (ice-9 popen)
35 #:use-module (rnrs io ports)
36 #:use-module (srfi srfi-1)
37 #:use-module (srfi srfi-11)
38 #:use-module (srfi srfi-34)
39 #:use-module (srfi srfi-64))
41 ;; Test the (guix profiles) module.
44 (open-connection-for-tests))
46 ;; Globally disable grafts because they can trigger early builds.
49 ;; Example manifest entries.
55 (item "/gnu/store/...")
62 (item "/gnu/store/...")
65 (define guile-2.0.9:debug
66 (manifest-entry (inherit guile-2.0.9)
73 (item "/gnu/store/...")
77 (test-begin "profiles")
79 (test-assert "manifest-installed?"
80 (let ((m (manifest (list guile-2.0.9 guile-2.0.9:debug))))
81 (and (manifest-installed? m (manifest-pattern (name "guile")))
82 (manifest-installed? m (manifest-pattern
83 (name "guile") (output "debug")))
84 (manifest-installed? m (manifest-pattern
85 (name "guile") (output "out")
87 (not (manifest-installed?
88 m (manifest-pattern (name "guile") (version "1.8.8"))))
89 (not (manifest-installed?
90 m (manifest-pattern (name "guile") (output "foobar")))))))
92 (test-assert "manifest-matching-entries"
93 (let* ((e (list guile-2.0.9 guile-2.0.9:debug))
96 (manifest-matching-entries m
97 (list (manifest-pattern
100 (equal? (list guile-2.0.9)
101 (manifest-matching-entries m
102 (list (manifest-pattern
104 (version "2.0.9"))))))))
106 (test-assert "manifest-matching-entries, no match"
107 (let ((m (manifest (list guile-2.0.9)))
108 (p (manifest-pattern (name "python"))))
109 (guard (c ((unmatched-pattern-error? c)
110 (and (eq? p (unmatched-pattern-error-pattern c))
111 (eq? m (unmatched-pattern-error-manifest c)))))
112 (manifest-matching-entries m (list p))
115 (test-equal "concatenate-manifests"
116 (manifest (list guile-2.0.9 glibc))
117 (concatenate-manifests (list (manifest (list guile-2.0.9))
118 (manifest (list glibc)))))
120 (test-assert "manifest-remove"
121 (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug)))
122 (m1 (manifest-remove m0
123 (list (manifest-pattern (name "guile")))))
124 (m2 (manifest-remove m1
125 (list (manifest-pattern (name "guile"))))) ; same
126 (m3 (manifest-remove m2
127 (list (manifest-pattern
128 (name "guile") (output "debug")))))
129 (m4 (manifest-remove m3
130 (list (manifest-pattern (name "guile"))))))
131 (match (manifest-entries m2)
132 ((($ <manifest-entry> "guile" "2.0.9" "debug"))
134 (null? (manifest-entries m3))
135 (null? (manifest-entries m4)))))))
137 (test-assert "manifest-add"
138 (let* ((m0 (manifest '()))
139 (m1 (manifest-add m0 (list guile-1.8.8)))
140 (m2 (manifest-add m1 (list guile-2.0.9)))
141 (m3 (manifest-add m2 (list guile-2.0.9:debug)))
142 (m4 (manifest-add m3 (list guile-2.0.9:debug))))
143 (and (match (manifest-entries m1)
144 ((($ <manifest-entry> "guile" "1.8.8" "out")) #t)
146 (match (manifest-entries m2)
147 ((($ <manifest-entry> "guile" "2.0.9" "out")) #t)
151 (test-equal "manifest-add removes duplicates" ;<https://bugs.gnu.org/30569>
153 (manifest-entries (manifest-add (manifest '())
154 (list guile-2.0.9 guile-2.0.9))))
156 (test-equal "manifest->code, simple"
158 (specifications->manifest (list "guile" "guile:debug" "glibc")))
159 (manifest->code (manifest (list guile-2.0.9 guile-2.0.9:debug glibc))))
161 (test-equal "manifest->code, simple, versions"
163 (specifications->manifest (list "guile@2.0.9" "guile@2.0.9:debug"
165 (manifest->code (manifest (list guile-2.0.9 guile-2.0.9:debug glibc))
166 #:entry-package-version manifest-entry-version))
168 (test-equal "manifest->code, transformations"
170 (use-modules (guix transformations))
173 (options->transformation '((foo . "bar"))))
176 (list (transform1 (specification->package "guile"))
177 (specification->package "glibc"))))
178 (manifest->code (manifest (list (manifest-entry
179 (inherit guile-2.0.9)
180 (properties `((transformations
181 . ((foo . "bar"))))))
184 (test-assert "manifest-perform-transaction"
185 (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug)))
186 (t1 (manifest-transaction
187 (install (list guile-1.8.8))
188 (remove (list (manifest-pattern (name "guile")
189 (output "debug"))))))
190 (t2 (manifest-transaction
191 (remove (list (manifest-pattern (name "guile")
194 (m1 (manifest-perform-transaction m0 t1))
195 (m2 (manifest-perform-transaction m1 t2))
196 (m3 (manifest-perform-transaction m0 t2)))
197 (and (match (manifest-entries m1)
198 ((($ <manifest-entry> "guile" "1.8.8" "out")) #t)
201 (null? (manifest-entries m3)))))
203 (test-assert "manifest-transaction-effects"
204 (let* ((m0 (manifest (list guile-1.8.8)))
205 (t (manifest-transaction
206 (install (list guile-2.0.9 glibc)))))
207 (let-values (((remove install upgrade downgrade)
208 (manifest-transaction-effects m0 t)))
209 (and (null? remove) (null? downgrade)
210 (equal? (list glibc) install)
211 (equal? (list (cons guile-1.8.8 guile-2.0.9)) upgrade)))))
213 (test-assert "manifest-transaction-effects no double install or upgrades"
214 (let* ((m0 (manifest (list guile-1.8.8)))
215 (t (manifest-transaction
216 (install (list guile-2.0.9 glibc glibc)))))
217 (let-values (((remove install upgrade downgrade)
218 (manifest-transaction-effects m0 t)))
219 (and (null? remove) (null? downgrade)
220 (equal? (list glibc) install)
221 (equal? (list (cons guile-1.8.8 guile-2.0.9)) upgrade)))))
223 (test-assert "manifest-transaction-effects and downgrades"
224 (let* ((m0 (manifest (list guile-2.0.9)))
225 (t (manifest-transaction (install (list guile-1.8.8)))))
226 (let-values (((remove install upgrade downgrade)
227 (manifest-transaction-effects m0 t)))
228 (and (null? remove) (null? install) (null? upgrade)
229 (equal? (list (cons guile-2.0.9 guile-1.8.8)) downgrade)))))
231 (test-assert "manifest-transaction-effects no double downgrade"
232 (let* ((m0 (manifest (list guile-2.0.9)))
233 (t (manifest-transaction (install (list guile-1.8.8 guile-1.8.8)))))
234 (let-values (((remove install upgrade downgrade)
235 (manifest-transaction-effects m0 t)))
236 (and (null? remove) (null? install) (null? upgrade)
237 (equal? (list (cons guile-2.0.9 guile-1.8.8)) downgrade)))))
239 (test-assert "manifest-transaction-effects and pseudo-upgrades"
240 (let* ((m0 (manifest (list guile-2.0.9)))
241 (t (manifest-transaction (install (list guile-2.0.9)))))
242 (let-values (((remove install upgrade downgrade)
243 (manifest-transaction-effects m0 t)))
244 (and (null? remove) (null? install) (null? downgrade)
245 (equal? (list (cons guile-2.0.9 guile-2.0.9)) upgrade)))))
247 (test-assert "manifest-transaction-null?"
248 (manifest-transaction-null? (manifest-transaction)))
250 (test-assert "manifest-transaction-removal-candidate?"
251 (let ((m (manifest (list guile-2.0.9)))
252 (t (manifest-transaction
253 (remove (list (manifest-pattern (name "guile")))))))
254 (and (manifest-transaction-removal-candidate? guile-2.0.9 t)
255 (not (manifest-transaction-removal-candidate? glibc t)))))
257 (test-assert "manifest-transaction-effects no double removal"
258 (let* ((m0 (manifest (list guile-2.0.9)))
259 (t (manifest-transaction
260 (remove (list (manifest-pattern (name "guile")))))))
261 (let-values (((remove install upgrade downgrade)
262 (manifest-transaction-effects m0 t)))
263 (and (= 1 (length remove))
264 (manifest-transaction-removal-candidate? guile-2.0.9 t)
265 (null? install) (null? downgrade) (null? upgrade)))))
267 (test-assert "package->development-manifest"
268 (let ((manifest (package->development-manifest packages:hello)))
269 (every (lambda (name)
270 (manifest-installed? manifest
271 (manifest-pattern (name name))))
272 '("gcc" "binutils" "glibc" "coreutils" "grep" "sed"))))
274 (test-assertm "profile-derivation"
276 ((entry -> (package->manifest-entry %bootstrap-guile))
277 (guile (package->derivation %bootstrap-guile))
278 (drv (profile-derivation (manifest (list entry))
281 (profile -> (derivation->output-path drv))
282 (bindir -> (string-append profile "/bin"))
283 (_ (built-derivations (list drv))))
284 (return (and (file-exists? (string-append bindir "/guile"))
285 (string=? (dirname (readlink bindir))
286 (derivation->output-path guile))))))
288 (test-assertm "profile-derivation format version 3"
289 ;; Make sure we can create and read a version 3 manifest.
291 ((entry -> (package->manifest-entry %bootstrap-guile
292 #:properties '((answer . 42))))
293 (manifest -> (manifest (list entry)))
294 (drv1 (profile-derivation manifest
295 #:format-version 3 ;old version
298 (drv2 (profile-derivation manifest
301 (profile1 -> (derivation->output-path drv1))
302 (profile2 -> (derivation->output-path drv2))
303 (_ (built-derivations (list drv1 drv2))))
304 (return (let ((manifest1 (profile-manifest profile1))
305 (manifest2 (profile-manifest profile2)))
306 (match (manifest-entries manifest1)
308 (match (manifest-entries manifest2)
310 (and (manifest-entry=? entry1 entry2)
311 (equal? (manifest-entry-properties entry1)
313 (equal? (manifest-entry-properties entry2)
314 '((answer . 42))))))))))))
316 (test-assertm "profile-derivation, ordering & collisions"
317 ;; ENTRY1 and ENTRY2 both provide 'bin/guile'--a collision. Make sure
318 ;; ENTRY1 "wins" over ENTRY2. See <https://bugs.gnu.org/49102>.
320 ((entry1 -> (package->manifest-entry %bootstrap-guile))
321 (entry2 -> (manifest-entry
328 (mkdir (string-append #$output "/bin"))
329 (call-with-output-file
330 (string-append #$output "/bin/guile")
332 (display "Fake!\n" port))))
333 #:guile %bootstrap-guile))))
334 (guile (package->derivation %bootstrap-guile))
335 (drv (profile-derivation (manifest (list entry1 entry2))
338 (profile -> (derivation->output-path drv))
339 (bindir -> (string-append profile "/bin"))
340 (file -> (string-append bindir "/guile"))
341 (_ (built-derivations (list drv))))
342 (return (string=? (readlink file)
344 (derivation->output-path guile)
347 (test-assertm "load-profile"
349 ((entry -> (package->manifest-entry %bootstrap-guile))
350 (guile (package->derivation %bootstrap-guile))
351 (drv (profile-derivation (manifest (list entry))
354 (profile -> (derivation->output-path drv))
355 (bindir -> (string-append profile "/bin"))
356 (_ (built-derivations (list drv))))
357 (define-syntax-rule (with-environment-excursion exp ...)
358 (let ((env (environ)))
362 (lambda () (environ env)))))
364 (return (and (with-environment-excursion
365 (load-profile profile)
366 (and (string-prefix? (string-append bindir ":")
368 (getenv "GUILE_LOAD_PATH")))
369 (with-environment-excursion
370 (load-profile profile #:pure? #t #:white-list '())
371 (equal? (list (string-append "PATH=" bindir))
374 (test-assertm "<profile>"
376 ((entry -> (package->manifest-entry %bootstrap-guile))
377 (profile -> (profile (hooks '()) (locales? #f)
378 (content (manifest (list entry)))))
379 (drv (lower-object profile))
380 (profile -> (derivation->output-path drv))
381 (bindir -> (string-append profile "/bin"))
382 (_ (built-derivations (list drv))))
383 (return (file-exists? (string-append bindir "/guile")))))
385 (test-assertm "profile-derivation relative symlinks, one entry"
387 ((entry -> (package->manifest-entry %bootstrap-guile))
388 (guile (package->derivation %bootstrap-guile))
389 (drv (profile-derivation (manifest (list entry))
390 #:relative-symlinks? #t
393 (profile -> (derivation->output-path drv))
394 (bindir -> (string-append profile "/bin"))
395 (_ (built-derivations (list drv))))
396 (return (and (file-exists? (string-append bindir "/guile"))
397 (string=? (readlink bindir)
400 (derivation->output-path guile))
403 (unless (network-reachable?) (test-skip 1))
404 (test-assertm "profile-derivation relative symlinks, two entries"
406 ((manifest -> (packages->manifest
407 (list %bootstrap-guile gnu-make-for-tests)))
408 (guile (package->derivation %bootstrap-guile))
409 (make (package->derivation gnu-make-for-tests))
410 (drv (profile-derivation manifest
411 #:relative-symlinks? #t
414 (profile -> (derivation->output-path drv))
415 (bindir -> (string-append profile "/bin"))
416 (_ (built-derivations (list drv))))
417 (return (and (file-exists? (string-append bindir "/guile"))
418 (file-exists? (string-append bindir "/make"))
419 (string=? (readlink (string-append bindir "/guile"))
420 (string-append "../../"
422 (derivation->output-path guile))
424 (string=? (readlink (string-append bindir "/make"))
425 (string-append "../../"
427 (derivation->output-path make))
430 (test-assertm "profile-derivation, inputs"
432 ((entry -> (package->manifest-entry packages:glibc "debug"))
433 (drv (profile-derivation (manifest (list entry))
436 (return (derivation-inputs drv))))
438 (test-assertm "profile-derivation, cross-compilation"
440 ((manifest -> (packages->manifest (list packages:sed packages:grep)))
441 (target -> "arm-linux-gnueabihf")
442 (grep (package->cross-derivation packages:grep target))
443 (sed (package->cross-derivation packages:sed target))
444 (locales (package->derivation packages:glibc-utf8-locales))
445 (drv (profile-derivation manifest
449 (define (find-input package)
450 (let ((name (string-append (package-full-name package "-") ".drv")))
452 (let ((input (derivation-input-path input)))
453 (and (string-suffix? name input) input)))
454 (derivation-inputs drv))))
456 ;; The inputs for grep and sed should be cross-build derivations, but that
457 ;; for the glibc-utf8-locales should be a native build.
458 (return (and (string=? (derivation-system drv) (%current-system))
459 (string=? (find-input packages:grep)
460 (derivation-file-name grep))
461 (string=? (find-input packages:sed)
462 (derivation-file-name sed))
463 (string=? (find-input packages:glibc-utf8-locales)
464 (derivation-file-name locales))))))
466 (test-assert "package->manifest-entry defaults to \"out\""
467 (let ((outputs (package-outputs packages:glibc)))
468 (equal? (manifest-entry-output
469 (package->manifest-entry (package
470 (inherit packages:glibc)
471 (outputs (reverse outputs)))))
472 (manifest-entry-output
473 (package->manifest-entry packages:glibc))
476 (test-assertm "profile-manifest, search-paths"
479 (inherit %bootstrap-guile)
481 (package-native-search-paths packages:guile-2.0))))
482 (entry -> (package->manifest-entry guile))
483 (drv (profile-derivation (manifest (list entry))
486 (profile -> (derivation->output-path drv)))
488 (built-derivations (list drv))
490 ;; Read the manifest back and make sure search paths are preserved.
491 (let ((manifest (profile-manifest profile)))
492 (match (manifest-entries manifest)
494 (return (equal? (manifest-entry-search-paths result)
495 (manifest-entry-search-paths entry)
496 (package-native-search-paths
497 packages:guile-2.0)))))))))
499 (test-assert "package->manifest-entry, search paths"
500 ;; See <http://bugs.gnu.org/22073>.
501 (let ((mpl (@ (gnu packages python-xyz) python-matplotlib)))
503 (package-transitive-native-search-paths mpl)
504 (manifest-entry-search-paths
505 (package->manifest-entry mpl)))))
507 (test-assert "packages->manifest, no duplicates"
511 (package->manifest-entry packages:guile-2.2))))
512 (manifest (packages->manifest
513 (list packages:guile-2.2 packages:guile-2.2))))
514 (every manifest-entry=? (manifest-entries expected)
515 (manifest-entries manifest))))
517 (test-equal "packages->manifest, propagated inputs"
520 (list (package-name package) (package-version package)
522 (package-propagated-inputs packages:guile-2.2))
524 (list (manifest-entry-name entry)
525 (manifest-entry-version entry)
526 (manifest-entry-item entry)))
527 (manifest-entry-dependencies
528 (package->manifest-entry packages:guile-2.2))))
530 (test-assert "manifest-entry-parent"
531 (let ((entry (package->manifest-entry packages:guile-2.2)))
532 (match (manifest-entry-dependencies entry)
534 (and (every (lambda (parent)
535 (eq? entry (force parent)))
536 (map manifest-entry-parent dependencies))
537 (not (force (manifest-entry-parent entry))))))))
539 (test-assertm "read-manifest"
540 (mlet* %store-monad ((manifest -> (packages->manifest
542 (inherit %bootstrap-guile)
544 (package-native-search-paths
545 packages:guile-2.0))))))
546 (drv (profile-derivation manifest
549 (out -> (derivation->output-path drv)))
550 (define (entry->sexp entry)
551 (list (manifest-entry-name entry)
552 (manifest-entry-version entry)
553 (manifest-entry-search-paths entry)
554 (manifest-entry-dependencies entry)
555 (force (manifest-entry-parent entry))))
558 (built-derivations (list drv))
559 (let ((manifest2 (profile-manifest out)))
560 (return (equal? (map entry->sexp (manifest-entries manifest))
561 (map entry->sexp (manifest-entries manifest2))))))))
563 (test-equal "collision"
564 '(("guile-bootstrap" "2.0") ("guile-bootstrap" "42"))
565 (guard (c ((profile-collision-error? c)
566 (let ((entry1 (profile-collision-error-entry c))
567 (entry2 (profile-collision-error-conflict c)))
568 (list (list (manifest-entry-name entry1)
569 (manifest-entry-version entry1))
570 (list (manifest-entry-name entry2)
571 (manifest-entry-version entry2))))))
572 (run-with-store %store
573 (mlet* %store-monad ((p0 -> (package
574 (inherit %bootstrap-guile)
576 (p1 -> (dummy-package "p1"
577 (propagated-inputs `(("p0" ,p0)))))
578 (manifest -> (packages->manifest
579 (list %bootstrap-guile p1)))
580 (drv (profile-derivation manifest
585 (test-equal "collision of propagated inputs"
586 '(("guile-bootstrap" "2.0") "p1"
587 <> ("guile-bootstrap" "42") "p2")
588 (guard (c ((profile-collision-error? c)
589 (let ((entry1 (profile-collision-error-entry c))
590 (entry2 (profile-collision-error-conflict c)))
591 (list (list (manifest-entry-name entry1)
592 (manifest-entry-version entry1))
594 (force (manifest-entry-parent entry1)))
596 (list (manifest-entry-name entry2)
597 (manifest-entry-version entry2))
599 (force (manifest-entry-parent entry2)))))))
600 (run-with-store %store
601 (mlet* %store-monad ((p0 -> (package
602 (inherit %bootstrap-guile)
604 (p1 -> (dummy-package "p1"
606 `(("guile" ,%bootstrap-guile)))))
607 (p2 -> (dummy-package "p2"
610 (manifest -> (packages->manifest (list p1 p2)))
611 (drv (profile-derivation manifest
616 (test-assertm "deduplication of repeated entries"
617 ;; Make sure the 'manifest' file does not duplicate identical entries.
618 ;; See <https://issues.guix.gnu.org/55499>.
619 (mlet* %store-monad ((p0 -> (dummy-package "p0"
620 (build-system trivial-build-system)
622 `(#:guile ,%bootstrap-guile
623 #:builder (mkdir (assoc-ref %outputs "out"))))
625 `(("guile" ,%bootstrap-guile)))))
629 (drv (profile-derivation (packages->manifest
634 (built-derivations (list drv))
635 (let ((file (string-append (derivation->output-path drv)
637 (manifest (profile-manifest (derivation->output-path drv))))
638 (define (contains-repeated? sexp)
640 (('repeated _ ...) #t)
641 ((lst ...) (any contains-repeated? sexp))
644 (return (and (contains-repeated? (call-with-input-file file read))
646 ;; MANIFEST has two entries for %BOOTSTRAP-GUILE since
647 ;; it's propagated both from P0 and from P1. When
648 ;; reading a 'repeated' node, 'read-manifest' should
649 ;; reuse the previously-read entry so the two
650 ;; %BOOTSTRAP-GUILE entries must be 'eq?'.
651 (match (manifest-entries manifest)
652 (((= manifest-entry-dependencies (dep0))
653 (= manifest-entry-dependencies (dep1)))
654 (and (string=? (manifest-entry-name dep0)
655 (package-name %bootstrap-guile))
656 (eq? dep0 dep1))))))))))
658 (test-assertm "no collision"
659 ;; Here we have an entry that is "lowered" (its 'item' field is a store file
660 ;; name) and another entry (its 'item' field is a package) that is
662 (mlet* %store-monad ((p -> (dummy-package "p"
664 `(("guile" ,%bootstrap-guile)))))
665 (guile (package->derivation %bootstrap-guile))
666 (entry -> (manifest-entry
667 (inherit (package->manifest-entry
669 (item (derivation->output-path guile))))
670 (manifest -> (manifest
672 (package->manifest-entry p))))
673 (drv (profile-derivation manifest)))
674 (return (->bool drv))))
676 (test-assertm "etc/profile"
677 ;; Make sure we get an 'etc/profile' file that at least defines $PATH.
680 (inherit %bootstrap-guile)
682 (package-native-search-paths packages:guile-2.0))))
683 (entry -> (package->manifest-entry guile))
684 (drv (profile-derivation (manifest (list entry))
687 (profile -> (derivation->output-path drv)))
689 (built-derivations (list drv))
690 (let* ((pipe (open-input-pipe
691 (string-append "unset GUIX_PROFILE; "
692 ;; 'source' is a Bashism; use '.' (dot).
693 ". " profile "/etc/profile; "
694 ;; Don't try to parse set(1) output because
695 ;; it differs among shells; just use echo.
697 (path (get-string-all pipe)))
699 (and (zero? (close-pipe pipe))
700 (string-contains path (string-append profile "/bin"))))))))
702 (test-assertm "etc/profile when etc/ already exists"
703 ;; Here 'union-build' makes the profile's etc/ a symlink to the package's
704 ;; etc/ directory, which makes it read-only. Make sure the profile build
707 ((thing -> (dummy-package "dummy"
708 (build-system trivial-build-system)
710 `(#:guile ,%bootstrap-guile
712 (let ((out (assoc-ref %outputs "out")))
714 (mkdir (string-append out "/etc"))
715 (call-with-output-file (string-append out "/etc/foo")
717 (display "foo!" port)))
719 (entry -> (package->manifest-entry thing))
720 (drv (profile-derivation (manifest (list entry))
723 (profile -> (derivation->output-path drv)))
725 (built-derivations (list drv))
726 (return (and (file-exists? (string-append profile "/etc/profile"))
727 (string=? (call-with-input-file
728 (string-append profile "/etc/foo")
732 (test-assertm "etc/profile when etc/ is a symlink"
733 ;; When etc/ is a symlink, the unsymlink code in 0.8.2 would fail
734 ;; gracelessly because 'scandir' would return #f.
736 ((thing -> (dummy-package "dummy"
737 (build-system trivial-build-system)
739 `(#:guile ,%bootstrap-guile
741 (let ((out (assoc-ref %outputs "out")))
743 (mkdir (string-append out "/foo"))
744 (symlink "foo" (string-append out "/etc"))
745 (call-with-output-file (string-append out "/etc/bar")
747 (display "foo!" port)))
749 (entry -> (package->manifest-entry thing))
750 (drv (profile-derivation (manifest (list entry))
753 (profile -> (derivation->output-path drv)))
755 (built-derivations (list drv))
756 (return (and (file-exists? (string-append profile "/etc/profile"))
757 (string=? (call-with-input-file
758 (string-append profile "/etc/bar")
762 (test-assertm "profile-derivation when etc/ is a relative symlink"
763 ;; See <https://bugs.gnu.org/32686>.
765 ((etc (gexp->derivation
769 (call-with-output-file (string-append #$output "/foo")
771 (display "Heya!" port))))))
772 (thing -> (dummy-package "dummy"
773 (build-system trivial-build-system)
777 `(#:guile ,%bootstrap-guile
779 (let ((out (assoc-ref %outputs "out"))
780 (etc (assoc-ref %build-inputs "etc")))
782 (symlink etc (string-append out "/etc"))
784 (entry -> (package->manifest-entry thing))
785 (drv (profile-derivation (manifest (list entry))
786 #:relative-symlinks? #t
789 (profile -> (derivation->output-path drv)))
791 (built-derivations (list drv))
792 (return (string=? (call-with-input-file
793 (string-append profile "/etc/foo")
797 (test-equalm "union vs. dangling symlink" ;<https://bugs.gnu.org/26949>
800 ((thing1 -> (dummy-package "dummy"
801 (build-system trivial-build-system)
803 `(#:guile ,%bootstrap-guile
805 (let ((out (assoc-ref %outputs "out")))
807 (symlink "does-not-exist"
808 (string-append out "/dangling"))
810 (thing2 -> (package (inherit thing1) (name "dummy2")))
811 (drv (profile-derivation (packages->manifest
812 (list thing1 thing2))
815 (profile -> (derivation->output-path drv)))
817 (built-derivations (list drv))
818 (return (readlink (readlink (string-append profile "/dangling")))))))
820 (test-equalm "profile in profile"
823 ;; Make sure we can build a profile that has another profile has one of its
824 ;; entries. The new profile's /manifest and /etc/profile must override the
827 ((prof0 (profile-derivation
829 (list (package->manifest-entry %bootstrap-guile)))
832 (prof1 (profile-derivation
833 (manifest (list (manifest-entry
840 (built-derivations (list prof1))
841 (let ((out (derivation->output-path prof1)))
842 (return (and (file-exists?
843 (string-append out "/bin/guile"))
844 (let ((manifest (profile-manifest out)))
845 (match (manifest-entries manifest)
847 (list (manifest-entry-name entry)
848 (manifest-entry-version entry)))))))))))
850 (test-end "profiles")
853 ;;; eval: (put 'dummy-package 'scheme-indent-function 1)