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:
Ludovic Courtès 2023-12-06 17:55:49 +01:00
parent 4a6cef9d66
commit d98a0203b7
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 39 additions and 4 deletions

View file

@ -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))

View file

@ -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.