diff options
| -rw-r--r-- | guix/packages.scm | 22 | ||||
| -rw-r--r-- | tests/packages.scm | 15 |
2 files changed, 28 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 diff --git a/tests/packages.scm b/tests/packages.scm index 47d10af5bc..47fc34d3ce 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -717,6 +717,21 @@ (string=? (derivation-file-name (package-derivation %store p0)) (derivation-file-name (package-derivation %store p1))))) +(test-assert "package-derivation, different system" + ;; Make sure the 'system' argument of 'package-derivation' is respected. + (let* ((system (if (string=? (%current-system) "x86_64-linux") + "aarch64-linux" + "x86_64-linux")) + (drv (package-derivation %store (dummy-package "p") + system #:graft? #f))) + (define right-system? + (mlambdaq (drv) + (and (string=? (derivation-system drv) system) + (every (compose right-system? derivation-input-derivation) + (derivation-inputs drv))))) + + (right-system? drv))) + (test-assert "package-output" (let* ((package (dummy-package "p")) (drv (package-derivation %store package))) |