diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2021-07-01 21:30:46 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2021-07-01 21:34:42 +0200 |
| commit | 98c075c24e26798ef52ab66641faa7b0aa87726b (patch) | |
| tree | 675c5fe003ac0e117105b8c167f905b923894fab /guix/packages.scm | |
| parent | 6bd8501e6883aabb779b2464ade81f7e28b19412 (diff) | |
| download | guix-98c075c24e26798ef52ab66641faa7b0aa87726b.tar.gz guix-98c075c24e26798ef52ab66641faa7b0aa87726b.tar.xz | |
packages: 'package-derivation' honors 'system' again.
Fixes a regression introduced in
7d873f194ca69d6096d28d7a224ab78e83e34fe1.
Starting from 7d873f194ca69d6096d28d7a224ab78e83e34fe1, running
guix build -s aarch64-linux sed
on an x86_64-linux machine would return an x86_64-linux machine, whereby
only the top derivation of the graph would be aarch64-linux while all
its dependencies would be x86_64-linux.
* guix/packages.scm (expand-input): Add 'system' parameter and honor it.
(bag->derivation, bag->cross-derivation): Pass SYSTEM to 'expand-input'.
* tests/packages.scm ("package-derivation, different system"): New test.
Diffstat (limited to 'guix/packages.scm')
| -rw-r--r-- | guix/packages.scm | 22 |
1 files changed, 13 insertions, 9 deletions
diff --git a/guix/packages.scm b/guix/packages.scm index a66dbea1b7..3ba61b42c9 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -1211,7 +1211,7 @@ Return the cached result when available." (#f (cache! cache package key thunk))))))) -(define* (expand-input package input #:key target) +(define* (expand-input package input system #:key target) "Expand INPUT, an input tuple, to a name/<gexp-input> tuple. PACKAGE is only used to provide contextual information in exceptions." (with-monad %store-monad @@ -1224,15 +1224,19 @@ only used to provide contextual information in exceptions." ;; derivation. (((? string? name) (? package? package)) (mlet %store-monad ((drv (if target - (package->cross-derivation package target + (package->cross-derivation package + target system #:graft? #f) - (package->derivation package #:graft? #f)))) + (package->derivation package system + #:graft? #f)))) (return (list name (gexp-input drv #:native? (not target)))))) (((? string? name) (? package? package) (? string? output)) (mlet %store-monad ((drv (if target - (package->cross-derivation package target + (package->cross-derivation package + target system #:graft? #f) - (package->derivation package #:graft? #f)))) + (package->derivation package system + #:graft? #f)))) (return (list name (gexp-input drv output #:native? (not target)))))) (((? string? name) (? file-like? thing)) @@ -1462,7 +1466,7 @@ error reporting." (mlet* %store-monad ((system -> (bag-system bag)) (inputs -> (bag-transitive-inputs bag)) (input-drvs (mapm %store-monad - (cut expand-input context <>) + (cut expand-input context <> system) inputs)) (paths -> (delete-duplicates (append-map (match-lambda @@ -1489,15 +1493,15 @@ This is an internal procedure." (host -> (bag-transitive-host-inputs bag)) (host-drvs (mapm %store-monad (cut expand-input context <> - #:target target) + system #:target target) host)) (target* -> (bag-transitive-target-inputs bag)) (target-drvs (mapm %store-monad - (cut expand-input context <>) + (cut expand-input context <> system) target*)) (build -> (bag-transitive-build-inputs bag)) (build-drvs (mapm %store-monad - (cut expand-input context <>) + (cut expand-input context <> system) build)) (all -> (append build target* host)) (paths -> (delete-duplicates |