From 98c075c24e26798ef52ab66641faa7b0aa87726b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 1 Jul 2021 21:30:46 +0200 Subject: 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. --- guix/packages.scm | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) (limited to 'guix/packages.scm') 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 @@ (define-syntax cached (#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/ tuple. PACKAGE is only used to provide contextual information in exceptions." (with-monad %store-monad @@ -1224,15 +1224,19 @@ (define* (expand-input package input #:key target) ;; 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 @@ (define* (bag->derivation bag #:optional context) (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 @@ (define* (bag->cross-derivation bag #:optional context) (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 -- cgit v1.2.3