From b49caaa2b7f624c3395c8e872638282bcc420502 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sat, 6 Jun 2020 21:37:47 +0200
Subject: packages: Make 'bag-grafts' insensitive to '%current-target-system'.

Fixes <https://bugs.gnu.org/41713>.
Reported by Mathieu Othacehe.

* guix/packages.scm (bag-grafts): Wrap 'fold-bag-dependencies' calls in
'parameterize'.
* tests/packages.scm ("package->bag, sensitivity to
%current-target-system"): New test.
---
 tests/packages.scm | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)

(limited to 'tests')

diff --git a/tests/packages.scm b/tests/packages.scm
index d8f0d677a3..72e87dbfb7 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1006,6 +1006,39 @@
           (assoc-ref (bag-build-inputs bag) "libc")
           (assoc-ref (bag-build-inputs bag) "coreutils"))))
 
+(test-assert "package->bag, sensitivity to %current-target-system"
+  ;; https://bugs.gnu.org/41713
+  (let* ((lower (lambda* (name #:key system target inputs native-inputs
+                               #:allow-other-keys)
+                  (and (not target)
+                       (bag (name name) (system system) (target target)
+                            (build-inputs native-inputs)
+                            (host-inputs inputs)
+                            (build (lambda* (store name inputs
+                                                   #:key system target
+                                                   #:allow-other-keys)
+                                     (build-expression->derivation
+                                      store "foo" '(mkdir %output))))))))
+         (bs    (build-system
+                  (name 'build-system-without-cross-compilation)
+                  (description "Does not support cross compilation.")
+                  (lower lower)))
+         (dep   (dummy-package "dep" (build-system bs)))
+         (pkg   (dummy-package "example"
+                  (native-inputs `(("dep" ,dep)))))
+         (do-not-build (lambda (continue store lst . _) lst)))
+    (equal? (with-build-handler do-not-build
+              (parameterize ((%current-target-system "powerpc64le-linux-gnu")
+                             (%graft? #t))
+                (package-cross-derivation %store pkg
+                                          (%current-target-system)
+                                          #:graft? #t)))
+            (with-build-handler do-not-build
+              (package-cross-derivation %store
+                                        (package (inherit pkg))
+                                        "powerpc64le-linux-gnu"
+                                        #:graft? #t)))))
+
 (test-equal "package->bag, cross-compilation"
   `(,(%current-system) "foo86-hurd"
     (,(package-source gnu-make))
-- 
cgit v1.2.3