From 80963744a242257921917df5a901dc343d3a93db Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 14 May 2020 16:53:42 +0200
Subject: [PATCH] store: 'mapm/accumulate-builds' preserves
 '%current-target-system'.

Fixes <https://bugs.gnu.org/41182>.

* guix/store.scm (mapm/accumulate-builds): Pass #:system and #:target to
'run-with-store'.
* tests/store.scm ("mapm/accumulate-builds, %current-target-system"):
New test.
* tests/guix-pack.sh: Add 'guix pack -d --target' test.
---
 guix/store.scm     |  4 +++-
 tests/guix-pack.sh |  8 ++++++++
 tests/store.scm    | 17 +++++++++++++++++
 3 files changed, 28 insertions(+), 1 deletion(-)

diff --git a/guix/store.scm b/guix/store.scm
index 6c7c07fd2d..014d08aaec 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -1899,7 +1899,9 @@ (define (mapm/accumulate-builds mproc lst)
     (values (map/accumulate-builds store
                                    (lambda (obj)
                                      (run-with-store store
-                                       (mproc obj)))
+                                       (mproc obj)
+                                       #:system (%current-system)
+                                       #:target (%current-target-system)))
                                    lst)
             store)))
 
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index 14e3cda361..39b64791e2 100644
--- a/tests/guix-pack.sh
+++ b/tests/guix-pack.sh
@@ -40,6 +40,14 @@ trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
 drv="`guix pack coreutils -d --no-grafts`"
 guix gc -R "$drv" | grep "`guix build coreutils -d --no-grafts`"
 
+# Compute the derivation of a cross-compiled pack.  Make sure it refers to the
+# cross-compiled package and not to the native package.
+drv="`guix pack idutils -d --no-grafts --target=arm-linux-gnueabihf`"
+guix gc -R "$drv" | \
+    grep "`guix build idutils --target=arm-linux-gnueabihf -d --no-grafts`"
+if guix gc -R "$drv" | grep "`guix build idutils -d --no-grafts`";
+then false; else true; fi
+
 # Build a tarball with no compression.
 guix pack --compression=none --bootstrap guile-bootstrap
 
diff --git a/tests/store.scm b/tests/store.scm
index 0e80ccc239..0af099c1ad 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -475,6 +475,23 @@ (define (same? x y)
       (run-with-store %store
         (mapm/accumulate-builds built-derivations `((,d1) (,d2)))))))
 
+(test-equal "mapm/accumulate-builds, %current-target-system"
+  (make-list 2 '("i586-pc-gnu" "i586-pc-gnu"))
+  ;; Both the 'mapm' and 'mapm/accumulate-builds' procedures should see the
+  ;; right #:target.
+  (run-with-store %store
+    (mlet %store-monad ((lst1 (mapm %store-monad
+                                    (lambda _
+                                      (current-target-system))
+                                    '(a b)))
+                        (lst2 (mapm/accumulate-builds
+                               (lambda _
+                                 (current-target-system))
+                               '(a b))))
+      (return (list lst1 lst2)))
+    #:system system
+    #:target "i586-pc-gnu"))
+
 (test-assert "topologically-sorted, one item"
   (let* ((a (add-text-to-store %store "a" "a"))
          (b (add-text-to-store %store "b" "b" (list a)))