diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/grafts.scm | 50 | ||||
| -rw-r--r-- | tests/guix-environment-container.sh | 2 | ||||
| -rw-r--r-- | tests/guix-pack.sh | 4 | ||||
| -rw-r--r-- | tests/profiles.scm | 24 | ||||
| -rw-r--r-- | tests/transformations.scm | 5 |
5 files changed, 81 insertions, 4 deletions
diff --git a/tests/grafts.scm b/tests/grafts.scm index 63dbb13830..24c4d24359 100644 --- a/tests/grafts.scm +++ b/tests/grafts.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2019, 2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014-2019, 2022-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2021 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. @@ -268,6 +268,54 @@ (readlink (string-append out "/two"))) (file-exists? (string-append out "/one/replacement"))))))) +(test-assert "graft-derivation, multiple outputs need to be replaced" + ;; Build a reference graph like this: + ;; + ;; ,- p2:out --. + ;; v v + ;; p1:one <---- p1:two + ;; | + ;; `-> p0 + ;; + ;; Graft p0r in lieu of p0, and make sure all the paths from the grafted p2 + ;; lead to p0r. See <https://issues.guix.gnu.org/66662>. + (let* ((p0 (build-expression->derivation + %store "p0" '(mkdir (assoc-ref %outputs "out")))) + (p0r (build-expression->derivation + %store "P0" + '(let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/replacement") + (const #t))))) + (p1 (build-expression->derivation + %store "p1" + `(let ((one (assoc-ref %outputs "one")) + (two (assoc-ref %outputs "two")) + (p0 (assoc-ref %build-inputs "p0"))) + (mkdir one) + (mkdir two) + (symlink p0 (string-append one "/p0")) + (symlink one (string-append two "/link"))) + #:inputs `(("p0" ,p0)) + #:outputs '("one" "two"))) + (p2 (build-expression->derivation + %store "p2" + `(let ((out (assoc-ref %outputs "out"))) + (mkdir out) (chdir out) + (symlink (assoc-ref %build-inputs "p1:one") "one") + (symlink (assoc-ref %build-inputs "p1:two") "two")) + #:inputs `(("p1:one" ,p1 "one") + ("p1:two" ,p1 "two")))) + (p0g (list (graft + (origin p0) + (replacement p0r)))) + (p2d (graft-derivation %store p2 p0g))) + + (build-derivations %store (list p2d)) + (let ((out (derivation->output-path (pk 'p2d p2d)))) + (equal? (stat (string-append out "/one/p0/replacement")) + (stat (string-append out "/two/link/p0/replacement")))))) + (test-assert "graft-derivation with #:outputs" ;; Call 'graft-derivation' with a narrowed set of outputs passed as ;; #:outputs. diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh index a3bc1ab572..09704f751c 100644 --- a/tests/guix-environment-container.sh +++ b/tests/guix-environment-container.sh @@ -270,5 +270,5 @@ guix build hello -d env="$(type -P pre-inst-env)" guix shell -C -D guix -- "$env" guix build hello -d && false # cannot work hello_drv="$(guix build hello -d)" -hello_drv_nested="$(cd "$(dirname env)" && guix shell --bootstrap -CW -D guix -- "$env" guix build hello -d)" +hello_drv_nested="$(cd "$(dirname env)" && guix shell --bootstrap -E GUIX_BUILD_OPTIONS -CW -D guix -- "$env" guix build hello -d)" test "$hello_drv" = "$hello_drv_nested" diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh index 4042e54aeb..3204e821cf 100644 --- a/tests/guix-pack.sh +++ b/tests/guix-pack.sh @@ -30,7 +30,9 @@ fi guix pack --version # Use --no-substitutes because we need to verify we can do this ourselves. -GUIX_BUILD_OPTIONS="--no-substitutes" +# Use --no-grafts to avoid interference--e.g., --dry-run passing even when +# given an unsupported package. +GUIX_BUILD_OPTIONS="--no-substitutes --no-grafts" export GUIX_BUILD_OPTIONS test_directory="`mktemp -d`" diff --git a/tests/profiles.scm b/tests/profiles.scm index 9ad03f2b24..9c419ada93 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Alex Kost <alezost@gmail.com> ;;; ;;; This file is part of GNU Guix. @@ -382,6 +382,28 @@ (_ (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)) diff --git a/tests/transformations.scm b/tests/transformations.scm index 704818b9ed..755211d65d 100644 --- a/tests/transformations.scm +++ b/tests/transformations.scm @@ -187,6 +187,11 @@ (string=? (package-full-name dep) (package-full-name findutils))))))))))) +;; The following test requires grafting enabled, but it becomes extremely +;; expensive if there's a graft on glibc or other package deep in the graph. +(when (package-replacement (@ (gnu packages commencement) glibc-final)) + (test-skip 1)) + (test-assert "options->transformation, with-graft" (let* ((p (dummy-package "guix.scm" (inputs `(("foo" ,grep) |