X-Git-Url: http://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/07340cbebc1ef97c0196c631144775f5ce61d4f6..refs/heads/epiphany-next:/tests/profiles.scm diff --git a/tests/profiles.scm b/tests/profiles.scm index 2dec42bec1..9ad03f2b24 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2013-2022 Ludovic Courtès ;;; Copyright © 2014 Alex Kost ;;; ;;; This file is part of GNU Guix. @@ -23,7 +23,6 @@ #:use-module (guix gexp) #:use-module (guix store) #:use-module (guix monads) - #:use-module (guix grafts) #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix build-system trivial) @@ -154,6 +153,34 @@ (manifest-entries (manifest-add (manifest '()) (list guile-2.0.9 guile-2.0.9)))) +(test-equal "manifest->code, simple" + '(begin + (specifications->manifest (list "guile" "guile:debug" "glibc"))) + (manifest->code (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 @@ -237,6 +264,13 @@ (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)) @@ -251,6 +285,92 @@ (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 . + (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 "" (mlet* %store-monad ((entry -> (package->manifest-entry %bootstrap-guile)) @@ -378,7 +498,7 @@ (test-assert "package->manifest-entry, search paths" ;; See . - (let ((mpl (@ (gnu packages python-xyz) python2-matplotlib))) + (let ((mpl (@ (gnu packages python-xyz) python-matplotlib))) (lset= eq? (package-transitive-native-search-paths mpl) (manifest-entry-search-paths @@ -463,14 +583,20 @@ (return #f))))) (test-equal "collision of propagated inputs" - '(("guile-bootstrap" "2.0") ("guile-bootstrap" "42")) + '(("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-version entry2)) + (manifest-entry-name + (force (manifest-entry-parent entry2))))))) (run-with-store %store (mlet* %store-monad ((p0 -> (package (inherit %bootstrap-guile) @@ -487,6 +613,48 @@ #:locales? #f))) (return #f))))) +(test-assertm "deduplication of repeated entries" + ;; Make sure the 'manifest' file does not duplicate identical entries. + ;; See . + (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