aboutsummaryrefslogtreecommitdiff
# This list is used to avoid multiple name/email instances of the same
# contributors reported by "git log" and "git shortlog" commands.

Adriano Peluso <catonano@gmail.com>
Al McElrath <hello@yrns.org> <hello@atonesir.com>
Alex Sassmannshausen <alex@pompo.co> <alex.sassmannshausen@gmail.com>
Alexander I. Grafov <grafov@gmail.com>
Alírio Eyng <alirioeyng@gmail.com>
Amin Bandali <bandali@gnu.org> <mab@gnu.org>
Amirouche Boubekki <amirouche@hypermove.net>
Andreas Enge <andreas@enge.fr> <andreas.enge@inria.fr>
Andreas Enge <andreas@enge.fr> <privat@xobs-novena>
Andy Wingo <wingo@igalia.com> <wingo@pobox.com>
Ben Woodcroft <donttrustben@gmail.com>
Ben Woodcroft <donttrustben@gmail.com> <b.woodcroft@uq.edu.au>
Ben Woodcroft <donttrustben@gmail.com> <donttrustben near gmail.com>
Brett Gilio <brettg@gnu.org> <brettg@posteo.net>
Christine Lemmer-Webber <cwebber@dustycloud.org>
Claes Wallin (韋嘉誠) <claes.wallin@greatsinodevelopment.com>
Cyprien Nicolas <cyprien@nicolas.tf> <c.nicolas+gitorious@gmail.com>
Daniel Pimentel <d4n1@d4n1.org> <d4n1@member.fsf.org>
Danny Milosavljevic <dannym@scratchpost.org> <dannym+a@scratchpost.org>
David Hashe <david.hashe@dhashe.com> <address@hidden>
David Thompson <davet@gnu.org> <dthompson2@worcester.edu>
David Thompson <davet@gnu.org> <dthompson@member.fsf.org>
David Thompson <davet@gnu.org> <dthompson@vistahigherlearning.com>
Deck Pickard <deck.r.pickard@gmail.com> <nebu@kipple>
Eric Bavier <bavier@posteo.net> <ericbavier@gmail.com>
Eric Bavier <bavier@posteo.net> <bavier@member.fsf.org>
Eric Dvorsak <eric@dvorsak.fr> <yenda1@gmail.com>
Evgeny Pisemsky <mail@pisemsky.site> <evgeny@pisemsky.com>
George Clemmer <myglc2@gmail.com>
ison <ison@airmail.cc> <ison111@protonmail.com>
Ivan Vilata i Balaguer <ivan@selidor.net>
Jakob L. Kreuze <zerodaysfordays@sdf.org> <zerodaysfordays@sdf.lonestar.org>
Jeff Mickey <j@codemac.net> <jm@igneous.io>
John Darrington <jmd@gnu.org> <john@darrington.wattle.id.au>
John J. Foerch <jjfoerch@earthlink.net>
Joshua Grant <tadni@riseup.net> <gzg@riseup.net>
Joshua Grant <tadni@riseup.net> <jgrant@parenthetical.io>
Joshua Grant <tadni@riseup.net> <tadnimi@gmail.com>
Joshua Grant <tadni@riseup.net> <youlysses@riseup.net>
Juliana Sims <juli@incana.org> <jtsims@protonmail.com>
Kei Kebreau <kkebreau@posteo.net>
Leo Famulari <leo@famulari.name> <lfamular@gmail.com>
Liliana Marie Prikler <liliana.prikler@gmail.com>
Liliana Marie Prikler <liliana.prikler@gmail.com> Leo Prikler <leo.prikler@student.tugraz.at>
Ludovic Courtès <ludo@gnu.org> <ludovic.courtes@inria.fr>
Marek Benc <dusxmt@gmx.com> <merkur32@gmail.com>
Marius Bakke <marius@gnu.org> <mbakke@fastmail.com>
Marius Bakke <marius@gnu.org> <m.bakke@warwick.ac.uk>
Marius Bakke <marius@gnu.org> <marius.bakke@usit.uio.no>
Marius Bakke <marius@gnu.org> <mbakke@berlin.guixsd.org>
Mathieu Lirzin <mthl@gnu.org> <mthl@openmailbox.org>
Mathieu Lirzin <mthl@gnu.org> <mathieu.lirzin@openmailbox.org>
Mathieu Othacehe <m.othacehe@gmail.com>
Mathieu Othacehe <mathieu.othacehe@parrot.com>
Mathieu Othacehe <othacehe@gnu.org>
Matthew James Kraai <kraai@ftbfs.org>
Nikita Karetnikov <nikita@karetnikov.org> <nikita.karetnikov@gmail.com>
nikita <nikita@n0.is>
nikita <nikita@n0.is> ng0 <ng0@n0.is>
nikita <nikita@n0.is> Nils Gillmann <ng0@n0.is>
nikita <nikita@n0.is> Nils Gillmann <gillmann@infotropique.org>
nikita <nikita@n0.is> ng0 <ng0@crash.cx>
nikita <nikita@n0.is> <ng0@infotropique.org>
nikita <nikita@n0.is> <ng0@no-reply.infotropique.org>
nikita <nikita@n0.is> <ng0@no-reply.pragmatique.xyz>
nikita <nikita@n0.is> <ng0@pragmatique.xyz>
nikita <nikita@n0.is> <contact.ng0@cryptolab.net>
nikita <nikita@n0.is> <ng0@we.make.ritual.n0.is>
nikita <nikita@n0.is> <ngillmann@runbox.com>
nikita <nikita@n0.is> <niasterisk@grrlz.net>
nikita <nikita@n0.is> <ng@niasterisk.space>
nikita <nikita@n0.is> <ng0@libertad.pw>
Pierre Neidhardt <mail@ambrevar.xyz>
Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
Pjotr Prins <pjotr.guix@thebird.nl> <pjotr.public01@thebird.nl>
Pjotr Prins <pjotr.guix@thebird.nl> <pjotr.public12@thebird.nl>
Pjotr Prins <pjotr.guix@thebird.nl> <pjotr.public12@email>
Raimon Grau <raimonster@gmail.com> <raimon@3scale.net>
Raoul Jean Pierre Bonnal <ilpuccio.febo@gmail.com>
Raymond Nicholson <rain1@openmailbox.org>
Rene Saavedra <rennes@openmailbox.org>
Ricardo Wurmus <rekado@elephly.net>
Ricardo Wurmus <rekado@elephly.net> <ricardo.wurmus@mdc-berlin.de>
Sou Bunnbu (宋文武) <iyzsong@gmail.com>
Sou Bunnbu (宋文武) <iyzsong@gmail.com> <iyzsong@member.fsf.org>
Stefan Reichör <stefan@xsteve.at>
Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
Theodoros Foradis <theodoros.for@openmailbox.org> <theodoros@foradis.org>
Thomas Danckaert <thomas.danckaert@gmail.com> <post@thomasdanckaert.be>
Tobias Geerinckx-Rice <me@tobias.gr> <tobias.geerinckx.rice@gmail.com>
Tomas Volf <~@wolfsden.cz> <wolf@wolfsden.cz>
Tomáš Čech <sleep_walker@gnu.org> <sleep_walker@suse.cz>
Vincent Legoll <vincent.legoll@gmail.com> <vincent.legoll@idgrilles.fr>
Zheng Junjie <873216071@qq.com> Z572 <873216071@qq.com>
generated by cgit
de (manifest (list guile-2.0.9 guile-2.0.9:debug glibc)))) (test-equal "manifest->code, simple, versions" '(begin (specifications->manifest (list "guile@2.0.9" "guile@2.0.9:debug" "glibc@2.19"))) (manifest->code (manifest (list guile-2.0.9 guile-2.0.9:debug glibc)) #:entry-package-version manifest-entry-version)) (test-equal "manifest->code, transformations" '(begin (use-modules (guix transformations)) (define transform1 (options->transformation '((foo . "bar")))) (packages->manifest (list (transform1 (specification->package "guile")) (specification->package "glibc")))) (manifest->code (manifest (list (manifest-entry (inherit guile-2.0.9) (properties `((transformations . ((foo . "bar")))))) glibc)))) (test-assert "manifest-perform-transaction" (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug))) (t1 (manifest-transaction (install (list guile-1.8.8)) (remove (list (manifest-pattern (name "guile") (output "debug")))))) (t2 (manifest-transaction (remove (list (manifest-pattern (name "guile") (version "2.0.9") (output #f)))))) (m1 (manifest-perform-transaction m0 t1)) (m2 (manifest-perform-transaction m1 t2)) (m3 (manifest-perform-transaction m0 t2))) (and (match (manifest-entries m1) ((($ <manifest-entry> "guile" "1.8.8" "out")) #t) (_ #f)) (equal? m1 m2) (null? (manifest-entries m3))))) (test-assert "manifest-transaction-effects" (let* ((m0 (manifest (list guile-1.8.8))) (t (manifest-transaction (install (list guile-2.0.9 glibc))))) (let-values (((remove install upgrade downgrade) (manifest-transaction-effects m0 t))) (and (null? remove) (null? downgrade) (equal? (list glibc) install) (equal? (list (cons guile-1.8.8 guile-2.0.9)) upgrade))))) (test-assert "manifest-transaction-effects no double install or upgrades" (let* ((m0 (manifest (list guile-1.8.8))) (t (manifest-transaction (install (list guile-2.0.9 glibc glibc))))) (let-values (((remove install upgrade downgrade) (manifest-transaction-effects m0 t))) (and (null? remove) (null? downgrade) (equal? (list glibc) install) (equal? (list (cons guile-1.8.8 guile-2.0.9)) upgrade))))) (test-assert "manifest-transaction-effects and downgrades" (let* ((m0 (manifest (list guile-2.0.9))) (t (manifest-transaction (install (list guile-1.8.8))))) (let-values (((remove install upgrade downgrade) (manifest-transaction-effects m0 t))) (and (null? remove) (null? install) (null? upgrade) (equal? (list (cons guile-2.0.9 guile-1.8.8)) downgrade))))) (test-assert "manifest-transaction-effects no double downgrade" (let* ((m0 (manifest (list guile-2.0.9))) (t (manifest-transaction (install (list guile-1.8.8 guile-1.8.8))))) (let-values (((remove install upgrade downgrade) (manifest-transaction-effects m0 t))) (and (null? remove) (null? install) (null? upgrade) (equal? (list (cons guile-2.0.9 guile-1.8.8)) downgrade))))) (test-assert "manifest-transaction-effects and pseudo-upgrades" (let* ((m0 (manifest (list guile-2.0.9))) (t (manifest-transaction (install (list guile-2.0.9))))) (let-values (((remove install upgrade downgrade) (manifest-transaction-effects m0 t))) (and (null? remove) (null? install) (null? downgrade) (equal? (list (cons guile-2.0.9 guile-2.0.9)) upgrade))))) (test-assert "manifest-transaction-null?" (manifest-transaction-null? (manifest-transaction))) (test-assert "manifest-transaction-removal-candidate?" (let ((m (manifest (list guile-2.0.9))) (t (manifest-transaction (remove (list (manifest-pattern (name "guile"))))))) (and (manifest-transaction-removal-candidate? guile-2.0.9 t) (not (manifest-transaction-removal-candidate? glibc t))))) (test-assert "manifest-transaction-effects no double removal" (let* ((m0 (manifest (list guile-2.0.9))) (t (manifest-transaction (remove (list (manifest-pattern (name "guile"))))))) (let-values (((remove install upgrade downgrade) (manifest-transaction-effects m0 t))) (and (= 1 (length remove)) (manifest-transaction-removal-candidate? guile-2.0.9 t) (null? install) (null? downgrade) (null? upgrade))))) (test-assert "package->development-manifest" (let ((manifest (package->development-manifest packages:hello))) (every (lambda (name) (manifest-installed? manifest (manifest-pattern (name name)))) '("gcc" "binutils" "glibc" "coreutils" "grep" "sed")))) (test-assertm "profile-derivation" (mlet* %store-monad ((entry -> (package->manifest-entry %bootstrap-guile)) (guile (package->derivation %bootstrap-guile)) (drv (profile-derivation (manifest (list entry)) #:hooks '() #:locales? #f)) (profile -> (derivation->output-path drv)) (bindir -> (string-append profile "/bin")) (_ (built-derivations (list drv)))) (return (and (file-exists? (string-append bindir "/guile")) (string=? (dirname (readlink bindir)) (derivation->output-path guile)))))) (test-assertm "profile-derivation format version 3" ;; Make sure we can create and read a version 3 manifest. (mlet* %store-monad ((entry -> (package->manifest-entry %bootstrap-guile #:properties '((answer . 42)))) (manifest -> (manifest (list entry))) (drv1 (profile-derivation manifest #:format-version 3 ;old version #:hooks '() #:locales? #f)) (drv2 (profile-derivation manifest #:hooks '() #:locales? #f)) (profile1 -> (derivation->output-path drv1)) (profile2 -> (derivation->output-path drv2)) (_ (built-derivations (list drv1 drv2)))) (return (let ((manifest1 (profile-manifest profile1)) (manifest2 (profile-manifest profile2))) (match (manifest-entries manifest1) ((entry1) (match (manifest-entries manifest2) ((entry2) (and (manifest-entry=? entry1 entry2) (equal? (manifest-entry-properties entry1) '((answer . 42))) (equal? (manifest-entry-properties entry2) '((answer . 42)))))))))))) (test-assertm "profile-derivation, ordering & collisions" ;; ENTRY1 and ENTRY2 both provide 'bin/guile'--a collision. Make sure ;; ENTRY1 "wins" over ENTRY2. See <https://bugs.gnu.org/49102>. (mlet* %store-monad ((entry1 -> (package->manifest-entry %bootstrap-guile)) (entry2 -> (manifest-entry (name "fake-guile") (version "0") (item (computed-file "fake-guile" #~(begin (mkdir #$output) (mkdir (string-append #$output "/bin")) (call-with-output-file (string-append #$output "/bin/guile") (lambda (port) (display "Fake!\n" port)))) #:guile %bootstrap-guile)))) (guile (package->derivation %bootstrap-guile)) (drv (profile-derivation (manifest (list entry1 entry2)) #:hooks '() #:locales? #f)) (profile -> (derivation->output-path drv)) (bindir -> (string-append profile "/bin")) (file -> (string-append bindir "/guile")) (_ (built-derivations (list drv)))) (return (string=? (readlink file) (string-append (derivation->output-path guile) "/bin/guile"))))) (test-assertm "load-profile" (mlet* %store-monad ((entry -> (package->manifest-entry %bootstrap-guile)) (guile (package->derivation %bootstrap-guile)) (drv (profile-derivation (manifest (list entry)) #:hooks '() #:locales? #f)) (profile -> (derivation->output-path drv)) (bindir -> (string-append profile "/bin")) (_ (built-derivations (list drv)))) (define-syntax-rule (with-environment-excursion exp ...) (let ((env (environ))) (dynamic-wind (const #t) (lambda () exp ...) (lambda () (environ env))))) (return (and (with-environment-excursion (load-profile profile) (and (string-prefix? (string-append bindir ":") (getenv "PATH")) (getenv "GUILE_LOAD_PATH"))) (with-environment-excursion (load-profile profile #:pure? #t #:white-list '()) (equal? (list (string-append "PATH=" bindir)) (environ))))))) (test-assertm "<profile>" (mlet* %store-monad ((entry -> (package->manifest-entry %bootstrap-guile)) (profile -> (profile (hooks '()) (locales? #f) (content (manifest (list entry))))) (drv (lower-object profile)) (profile -> (derivation->output-path drv)) (bindir -> (string-append profile "/bin")) (_ (built-derivations (list drv)))) (return (file-exists? (string-append bindir "/guile"))))) (test-assertm "profile-derivation, #:system, and hooks" ;; Make sure all the profile hooks are built for the system specified with ;; #:system, even if that does not match (%current-system). ;; See <https://issues.guix.gnu.org/65225>. (mlet* %store-monad ((system -> (if (string=? (%current-system) "riscv64-linux") "x86_64-linux" "riscv64-linux")) (entry -> (package->manifest-entry packages:coreutils)) (_ (set-guile-for-build (default-guile) system)) (drv (profile-derivation (manifest (list entry)) #:system system)) (refs (references* (derivation-file-name drv)))) (return (and (string=? (derivation-system drv) system) (pair? refs) (every (lambda (ref) (or (not (string-suffix? ".drv" ref)) (let ((drv (read-derivation-from-file ref))) (string=? (derivation-system drv) system)))) refs))))) (test-assertm "profile-derivation relative symlinks, one entry" (mlet* %store-monad ((entry -> (package->manifest-entry %bootstrap-guile)) (guile (package->derivation %bootstrap-guile)) (drv (profile-derivation (manifest (list entry)) #:relative-symlinks? #t #:hooks '() #:locales? #f)) (profile -> (derivation->output-path drv)) (bindir -> (string-append profile "/bin")) (_ (built-derivations (list drv)))) (return (and (file-exists? (string-append bindir "/guile")) (string=? (readlink bindir) (string-append "../" (basename (derivation->output-path guile)) "/bin")))))) (unless (network-reachable?) (test-skip 1)) (test-assertm "profile-derivation relative symlinks, two entries" (mlet* %store-monad ((manifest -> (packages->manifest (list %bootstrap-guile gnu-make-for-tests))) (guile (package->derivation %bootstrap-guile)) (make (package->derivation gnu-make-for-tests)) (drv (profile-derivation manifest #:relative-symlinks? #t #:hooks '() #:locales? #f)) (profile -> (derivation->output-path drv)) (bindir -> (string-append profile "/bin")) (_ (built-derivations (list drv)))) (return (and (file-exists? (string-append bindir "/guile")) (file-exists? (string-append bindir "/make")) (string=? (readlink (string-append bindir "/guile")) (string-append "../../" (basename (derivation->output-path guile)) "/bin/guile")) (string=? (readlink (string-append bindir "/make")) (string-append "../../" (basename (derivation->output-path make)) "/bin/make")))))) (test-assertm "profile-derivation, inputs" (mlet* %store-monad ((entry -> (package->manifest-entry packages:glibc "debug")) (drv (profile-derivation (manifest (list entry)) #:hooks '() #:locales? #f))) (return (derivation-inputs drv)))) (test-assertm "profile-derivation, cross-compilation" (mlet* %store-monad ((manifest -> (packages->manifest (list packages:sed packages:grep))) (target -> "arm-linux-gnueabihf") (grep (package->cross-derivation packages:grep target)) (sed (package->cross-derivation packages:sed target)) (drv (profile-derivation manifest #:hooks '() #:locales? #t #:target target))) (define (find-input package) (let ((name (string-append (package-full-name package "-") ".drv"))) (any (lambda (input) (let ((input (derivation-input-path input))) (and (string-suffix? name input) input))) (derivation-inputs drv)))) (return (and (string=? (derivation-system drv) (%current-system)) (string=? (find-input packages:grep) (derivation-file-name grep)) (string=? (find-input packages:sed) (derivation-file-name sed)))))) (test-assert "package->manifest-entry defaults to \"out\"" (let ((outputs (package-outputs packages:glibc))) (equal? (manifest-entry-output (package->manifest-entry (package (inherit packages:glibc) (outputs (reverse outputs))))) (manifest-entry-output (package->manifest-entry packages:glibc)) "out"))) (test-assertm "profile-manifest, search-paths" (mlet* %store-monad ((guile -> (package (inherit %bootstrap-guile) (native-search-paths (package-native-search-paths packages:guile-2.0)))) (entry -> (package->manifest-entry guile)) (drv (profile-derivation (manifest (list entry)) #:hooks '() #:locales? #f)) (profile -> (derivation->output-path drv))) (mbegin %store-monad (built-derivations (list drv)) ;; Read the manifest back and make sure search paths are preserved. (let ((manifest (profile-manifest profile))) (match (manifest-entries manifest) ((result) (return (equal? (manifest-entry-search-paths result) (manifest-entry-search-paths entry) (package-native-search-paths packages:guile-2.0))))))))) (test-assert "package->manifest-entry, search paths" ;; See <http://bugs.gnu.org/22073>. (let ((mpl (@ (gnu packages python-xyz) python-matplotlib))) (lset= eq? (package-transitive-native-search-paths mpl) (manifest-entry-search-paths (package->manifest-entry mpl))))) (test-assert "packages->manifest, no duplicates" (let ((expected (manifest (list (package->manifest-entry packages:guile-2.2)))) (manifest (packages->manifest (list packages:guile-2.2 packages:guile-2.2)))) (every manifest-entry=? (manifest-entries expected) (manifest-entries manifest)))) (test-equal "packages->manifest, propagated inputs" (map (match-lambda ((label package) (list (package-name package) (package-version package) package))) (package-propagated-inputs packages:guile-2.2)) (map (lambda (entry) (list (manifest-entry-name entry) (manifest-entry-version entry) (manifest-entry-item entry))) (manifest-entry-dependencies (package->manifest-entry packages:guile-2.2)))) (test-assert "manifest-entry-parent" (let ((entry (package->manifest-entry packages:guile-2.2))) (match (manifest-entry-dependencies entry) ((dependencies ..1) (and (every (lambda (parent) (eq? entry (force parent))) (map manifest-entry-parent dependencies)) (not (force (manifest-entry-parent entry)))))))) (test-assertm "read-manifest" (mlet* %store-monad ((manifest -> (packages->manifest (list (package (inherit %bootstrap-guile) (native-search-paths (package-native-search-paths packages:guile-2.0)))))) (drv (profile-derivation manifest #:hooks '() #:locales? #f)) (out -> (derivation->output-path drv))) (define (entry->sexp entry) (list (manifest-entry-name entry) (manifest-entry-version entry) (manifest-entry-search-paths entry) (manifest-entry-dependencies entry) (force (manifest-entry-parent entry)))) (mbegin %store-monad (built-derivations (list drv)) (let ((manifest2 (profile-manifest out))) (return (equal? (map entry->sexp (manifest-entries manifest)) (map entry->sexp (manifest-entries manifest2)))))))) (test-equal "collision" '(("guile-bootstrap" "2.0") ("guile-bootstrap" "42")) (guard (c ((profile-collision-error? c) (let ((entry1 (profile-collision-error-entry c)) (entry2 (profile-collision-error-conflict c))) (list (list (manifest-entry-name entry1) (manifest-entry-version entry1)) (list (manifest-entry-name entry2) (manifest-entry-version entry2)))))) (run-with-store %store (mlet* %store-monad ((p0 -> (package (inherit %bootstrap-guile) (version "42"))) (p1 -> (dummy-package "p1" (propagated-inputs `(("p0" ,p0))))) (manifest -> (packages->manifest (list %bootstrap-guile p1))) (drv (profile-derivation manifest #:hooks '() #:locales? #f))) (return #f))))) (test-equal "collision of propagated inputs" '(("guile-bootstrap" "2.0") "p1" <> ("guile-bootstrap" "42") "p2") (guard (c ((profile-collision-error? c) (let ((entry1 (profile-collision-error-entry c)) (entry2 (profile-collision-error-conflict c))) (list (list (manifest-entry-name entry1) (manifest-entry-version entry1)) (manifest-entry-name (force (manifest-entry-parent entry1))) '<> (list (manifest-entry-name entry2) (manifest-entry-version entry2)) (manifest-entry-name (force (manifest-entry-parent entry2))))))) (run-with-store %store (mlet* %store-monad ((p0 -> (package (inherit %bootstrap-guile) (version "42"))) (p1 -> (dummy-package "p1" (propagated-inputs `(("guile" ,%bootstrap-guile))))) (p2 -> (dummy-package "p2" (propagated-inputs `(("guile" ,p0))))) (manifest -> (packages->manifest (list p1 p2))) (drv (profile-derivation manifest #:hooks '() #:locales? #f))) (return #f))))) (test-assertm "deduplication of repeated entries" ;; Make sure the 'manifest' file does not duplicate identical entries. ;; See <https://issues.guix.gnu.org/55499>. (mlet* %store-monad ((p0 -> (dummy-package "p0" (build-system trivial-build-system) (arguments `(#:guile ,%bootstrap-guile #:builder (mkdir (assoc-ref %outputs "out")))) (propagated-inputs `(("guile" ,%bootstrap-guile))))) (p1 -> (package (inherit p0) (name "p1"))) (drv (profile-derivation (packages->manifest (list p0 p1)) #:hooks '() #:locales? #f))) (mbegin %store-monad (built-derivations (list drv)) (let ((file (string-append (derivation->output-path drv) "/manifest")) (manifest (profile-manifest (derivation->output-path drv)))) (define (contains-repeated? sexp) (match sexp (('repeated _ ...) #t) ((lst ...) (any contains-repeated? sexp)) (_ #f))) (return (and (contains-repeated? (call-with-input-file file read)) ;; MANIFEST has two entries for %BOOTSTRAP-GUILE since ;; it's propagated both from P0 and from P1. When ;; reading a 'repeated' node, 'read-manifest' should ;; reuse the previously-read entry so the two ;; %BOOTSTRAP-GUILE entries must be 'eq?'. (match (manifest-entries manifest) (((= manifest-entry-dependencies (dep0)) (= manifest-entry-dependencies (dep1))) (and (string=? (manifest-entry-name dep0) (package-name %bootstrap-guile)) (eq? dep0 dep1)))))))))) (test-assertm "no collision" ;; Here we have an entry that is "lowered" (its 'item' field is a store file ;; name) and another entry (its 'item' field is a package) that is ;; equivalent. (mlet* %store-monad ((p -> (dummy-package "p" (propagated-inputs `(("guile" ,%bootstrap-guile))))) (guile (package->derivation %bootstrap-guile)) (entry -> (manifest-entry (inherit (package->manifest-entry %bootstrap-guile)) (item (derivation->output-path guile)))) (manifest -> (manifest (list entry (package->manifest-entry p)))) (drv (profile-derivation manifest))) (return (->bool drv)))) (test-assertm "etc/profile" ;; Make sure we get an 'etc/profile' file that at least defines $PATH. (mlet* %store-monad ((guile -> (package (inherit %bootstrap-guile) (native-search-paths (package-native-search-paths packages:guile-2.0)))) (entry -> (package->manifest-entry guile)) (drv (profile-derivation (manifest (list entry)) #:hooks '() #:locales? #f)) (profile -> (derivation->output-path drv))) (mbegin %store-monad (built-derivations (list drv)) (let* ((pipe (open-input-pipe (string-append "unset GUIX_PROFILE; " ;; 'source' is a Bashism; use '.' (dot). ". " profile "/etc/profile; " ;; Don't try to parse set(1) output because ;; it differs among shells; just use echo. "echo $PATH"))) (path (get-string-all pipe))) (return (and (zero? (close-pipe pipe)) (string-contains path (string-append profile "/bin")))))))) (test-assertm "etc/profile when etc/ already exists" ;; Here 'union-build' makes the profile's etc/ a symlink to the package's ;; etc/ directory, which makes it read-only. Make sure the profile build ;; handles that. (mlet* %store-monad ((thing -> (dummy-package "dummy" (build-system trivial-build-system) (arguments `(#:guile ,%bootstrap-guile #:builder (let ((out (assoc-ref %outputs "out"))) (mkdir out) (mkdir (string-append out "/etc")) (call-with-output-file (string-append out "/etc/foo") (lambda (port) (display "foo!" port))) #t))))) (entry -> (package->manifest-entry thing)) (drv (profile-derivation (manifest (list entry)) #:hooks '() #:locales? #f)) (profile -> (derivation->output-path drv))) (mbegin %store-monad (built-derivations (list drv)) (return (and (file-exists? (string-append profile "/etc/profile")) (string=? (call-with-input-file (string-append profile "/etc/foo") get-string-all) "foo!")))))) (test-assertm "etc/profile when etc/ is a symlink" ;; When etc/ is a symlink, the unsymlink code in 0.8.2 would fail ;; gracelessly because 'scandir' would return #f. (mlet* %store-monad ((thing -> (dummy-package "dummy" (build-system trivial-build-system) (arguments `(#:guile ,%bootstrap-guile #:builder (let ((out (assoc-ref %outputs "out"))) (mkdir out) (mkdir (string-append out "/foo")) (symlink "foo" (string-append out "/etc")) (call-with-output-file (string-append out "/etc/bar") (lambda (port) (display "foo!" port))) #t))))) (entry -> (package->manifest-entry thing)) (drv (profile-derivation (manifest (list entry)) #:hooks '() #:locales? #f)) (profile -> (derivation->output-path drv))) (mbegin %store-monad (built-derivations (list drv)) (return (and (file-exists? (string-append profile "/etc/profile")) (string=? (call-with-input-file (string-append profile "/etc/bar") get-string-all) "foo!")))))) (test-assertm "profile-derivation when etc/ is a relative symlink" ;; See <https://bugs.gnu.org/32686>. (mlet* %store-monad ((etc (gexp->derivation "etc" #~(begin (mkdir #$output) (call-with-output-file (string-append #$output "/foo") (lambda (port) (display "Heya!" port)))))) (thing -> (dummy-package "dummy" (build-system trivial-build-system) (inputs `(("etc" ,etc))) (arguments `(#:guile ,%bootstrap-guile #:builder (let ((out (assoc-ref %outputs "out")) (etc (assoc-ref %build-inputs "etc"))) (mkdir out) (symlink etc (string-append out "/etc")) #t))))) (entry -> (package->manifest-entry thing)) (drv (profile-derivation (manifest (list entry)) #:relative-symlinks? #t #:hooks '() #:locales? #f)) (profile -> (derivation->output-path drv))) (mbegin %store-monad (built-derivations (list drv)) (return (string=? (call-with-input-file (string-append profile "/etc/foo") get-string-all) "Heya!"))))) (test-equalm "union vs. dangling symlink" ;<https://bugs.gnu.org/26949> "does-not-exist" (mlet* %store-monad ((thing1 -> (dummy-package "dummy" (build-system trivial-build-system) (arguments `(#:guile ,%bootstrap-guile #:builder (let ((out (assoc-ref %outputs "out"))) (mkdir out) (symlink "does-not-exist" (string-append out "/dangling")) #t))))) (thing2 -> (package (inherit thing1) (name "dummy2"))) (drv (profile-derivation (packages->manifest (list thing1 thing2)) #:hooks '() #:locales? #f)) (profile -> (derivation->output-path drv))) (mbegin %store-monad (built-derivations (list drv)) (return (readlink (readlink (string-append profile "/dangling"))))))) (test-equalm "profile in profile" '("foo" "0") ;; Make sure we can build a profile that has another profile has one of its ;; entries. The new profile's /manifest and /etc/profile must override the ;; other's. (mlet* %store-monad ((prof0 (profile-derivation (manifest (list (package->manifest-entry %bootstrap-guile))) #:hooks '() #:locales? #f)) (prof1 (profile-derivation (manifest (list (manifest-entry (name "foo") (version "0") (item prof0)))) #:hooks '() #:locales? #f))) (mbegin %store-monad (built-derivations (list prof1)) (let ((out (derivation->output-path prof1))) (return (and (file-exists? (string-append out "/bin/guile")) (let ((manifest (profile-manifest out))) (match (manifest-entries manifest) ((entry) (list (manifest-entry-name entry) (manifest-entry-version entry))))))))))) (test-end "profiles") ;;; Local Variables: ;;; eval: (put 'dummy-package 'scheme-indent-function 1) ;;; End:
generated by cgit