mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
shell: ‘--development’ honors ‘--system’.
Fixes a bug whereby ‘package->development-manifest’ would run with the wrong system in mind, leading to errors like this: $ guix shell -s i586-gnu -D shepherd --no-grafts guix shell: error: package linux-libre-headers@5.15.49 does not support i586-gnu * guix/scripts/environment.scm (options/resolve-packages): Define ‘system’ and pass it to ‘package->development-manifest’.’ * tests/guix-shell.sh: Test it. Change-Id: I95c471c1918913ab80dec7d3ca64fe38583cce78
This commit is contained in:
parent
4a6cef9d66
commit
d98a0203b7
2 changed files with 39 additions and 4 deletions
|
@ -311,6 +311,9 @@ (define (load-manifest file) ;TODO: factorize
|
||||||
(define (options/resolve-packages store opts)
|
(define (options/resolve-packages store opts)
|
||||||
"Return OPTS with package specification strings replaced by manifest entries
|
"Return OPTS with package specification strings replaced by manifest entries
|
||||||
for the corresponding packages."
|
for the corresponding packages."
|
||||||
|
(define system
|
||||||
|
(assoc-ref opts 'system))
|
||||||
|
|
||||||
(define (manifest-entry=? e1 e2)
|
(define (manifest-entry=? e1 e2)
|
||||||
(and (eq? (manifest-entry-item e1) (manifest-entry-item e2))
|
(and (eq? (manifest-entry-item e1) (manifest-entry-item e2))
|
||||||
(string=? (manifest-entry-output e1)
|
(string=? (manifest-entry-output e1)
|
||||||
|
@ -327,11 +330,11 @@ (define (packages->outputs packages mode)
|
||||||
((? package? package)
|
((? package? package)
|
||||||
(if (eq? mode 'ad-hoc-package)
|
(if (eq? mode 'ad-hoc-package)
|
||||||
(list (package->manifest-entry* package))
|
(list (package->manifest-entry* package))
|
||||||
(manifest-entries (package->development-manifest package))))
|
(manifest-entries (package->development-manifest package system))))
|
||||||
(((? package? package) (? string? output))
|
(((? package? package) (? string? output))
|
||||||
(if (eq? mode 'ad-hoc-package)
|
(if (eq? mode 'ad-hoc-package)
|
||||||
(list (package->manifest-entry* package output))
|
(list (package->manifest-entry* package output))
|
||||||
(manifest-entries (package->development-manifest package))))
|
(manifest-entries (package->development-manifest package system))))
|
||||||
((lst ...)
|
((lst ...)
|
||||||
(append-map (cut packages->outputs <> mode) lst))))
|
(append-map (cut packages->outputs <> mode) lst))))
|
||||||
|
|
||||||
|
@ -345,7 +348,8 @@ (define (packages->outputs packages mode)
|
||||||
(('package 'package (? string? spec))
|
(('package 'package (? string? spec))
|
||||||
(manifest-entries
|
(manifest-entries
|
||||||
(package->development-manifest
|
(package->development-manifest
|
||||||
(transform (specification->package+output spec)))))
|
(transform (specification->package+output spec))
|
||||||
|
system)))
|
||||||
(('expression mode str)
|
(('expression mode str)
|
||||||
;; Add all the outputs of the package STR evaluates to.
|
;; Add all the outputs of the package STR evaluates to.
|
||||||
(packages->outputs (read/eval str) mode))
|
(packages->outputs (read/eval str) mode))
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
# GNU Guix --- Functional package management for GNU
|
# GNU Guix --- Functional package management for GNU
|
||||||
# Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org>
|
# Copyright © 2021-2023 Ludovic Courtès <ludo@gnu.org>
|
||||||
#
|
#
|
||||||
# This file is part of GNU Guix.
|
# This file is part of GNU Guix.
|
||||||
#
|
#
|
||||||
|
@ -103,6 +103,37 @@ guix shell --bootstrap --pure -D -f "$tmpdir/empty-package.scm" \
|
||||||
guile-bootstrap -- guile --version
|
guile-bootstrap -- guile --version
|
||||||
rm "$tmpdir/empty-package.scm"
|
rm "$tmpdir/empty-package.scm"
|
||||||
|
|
||||||
|
# Make sure '--development' honors '--system'.
|
||||||
|
this_system="$(guile -c '(use-modules (guix utils))
|
||||||
|
(display (%current-system))')"
|
||||||
|
other_system="$(guile -c '(use-modules (guix utils))
|
||||||
|
(display (if (string=? "riscv64-linux" (%current-system))
|
||||||
|
"x86_64-linux"
|
||||||
|
"riscv64-linux"))')"
|
||||||
|
cat > "$tmpdir/some-package.scm" <<EOF
|
||||||
|
(use-modules (guix utils)
|
||||||
|
(guix packages)
|
||||||
|
(gnu packages base))
|
||||||
|
|
||||||
|
(define unsupported-dependency
|
||||||
|
(package
|
||||||
|
(inherit grep)
|
||||||
|
(name "unsupported-dependency")
|
||||||
|
(supported-systems '())))
|
||||||
|
|
||||||
|
(package
|
||||||
|
(inherit hello)
|
||||||
|
(name "phony-package")
|
||||||
|
(inputs
|
||||||
|
(if (string=? (%current-system) "$this_system")
|
||||||
|
(list unsupported-dependency)
|
||||||
|
'())))
|
||||||
|
EOF
|
||||||
|
|
||||||
|
guix shell -D -f "$tmpdir/some-package.scm" -n && false
|
||||||
|
guix shell -D -f "$tmpdir/some-package.scm" -n -s "$other_system"
|
||||||
|
|
||||||
|
|
||||||
if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
|
if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
|
||||||
then
|
then
|
||||||
# Compute the build environment for the initial GNU Make.
|
# Compute the build environment for the initial GNU Make.
|
||||||
|
|
Loading…
Reference in a new issue