From df46bef48eaa43c502fa9193371692c039b460c1 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 24 Sep 2021 23:00:11 +0200
Subject: gexp: Leave grafting as is when lowering allowed/disallowed
 references.

Fixes <https://issues.guix.gnu.org/50676>.
Reported by Mathieu Othacehe <othacehe@gnu.org>.

Commit a779363b6aa581e88eda21f9f35530962d54ac25 was partially incorrect:
references passed to #:allowed-references or #:references-graphs *can*
be lowered as references to grafted elements.  This is for example the
case when doing:

  (computed-file "partition.img" exp
                  #:options `(#:references-graphs ,inputs))

Here INPUTS must be lowered as a reference to suitably grafted elements.
Failing to do that, the reference graph will not match the actual
INPUTS.

However, when building a package, those references must indeed refer
only to ungrafted packages.  This commit preserves that by having build
systems pass #:graft? #f.

* guix/gexp.scm (lower-reference-graphs, lower-references): Remove uses
of 'without-grafting'.  This reverts
a779363b6aa581e88eda21f9f35530962d54ac25.
* guix/build-system/cmake.scm (cmake-build, cmake-cross-build):
Pass #:graft? #f.
* guix/build-system/glib-or-gtk.scm (glib-or-gtk-build)
(glib-or-gtk-cross-build): Likewise.
* guix/build-system/gnu.scm (gnu-build, gnu-cross-build): Likewise.
* guix/build-system/meson.scm (meson-build, meson-cross-build): Likewise.
* guix/build-system/trivial.scm (trivial-build, trivial-cross-build):
Likewise.
* tests/gexp.scm ("lower-object, computed-file + grafts"): New test.
* tests/packages.scm ("trivial with #:allowed-references + grafts"): New
test.
---
 guix/gexp.scm | 17 +++++++----------
 1 file changed, 7 insertions(+), 10 deletions(-)

(limited to 'guix/gexp.scm')

diff --git a/guix/gexp.scm b/guix/gexp.scm
index ff5ede2857..56b1bb4951 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -923,9 +923,8 @@ corresponding <derivation-input> or store item."
 
   (match graphs
     (((file-names . inputs) ...)
-     (mlet %store-monad ((inputs (without-grafting
-                                  (lower-inputs (map tuple->gexp-input inputs)
-                                                system target))))
+     (mlet %store-monad ((inputs (lower-inputs (map tuple->gexp-input inputs)
+                                               system target)))
        (return (map cons file-names inputs))))))
 
 (define* (lower-references lst #:key system target)
@@ -938,15 +937,13 @@ names and file names suitable for the #:allowed-references argument to
        ((? string? output)
         (return output))
        (($ <gexp-input> thing output native?)
-        (mlet %store-monad ((drv (without-grafting
-                                  (lower-object thing system
-                                                #:target (if native?
-                                                             #f target)))))
+        (mlet %store-monad ((drv (lower-object thing system
+                                               #:target (if native?
+                                                            #f target))))
           (return (derivation->output-path drv output))))
        (thing
-        (mlet %store-monad ((drv (without-grafting
-                                  (lower-object thing system
-                                                #:target target))))
+        (mlet %store-monad ((drv (lower-object thing system
+                                               #:target target)))
           (return (derivation->output-path drv))))))
 
     (mapm/accumulate-builds lower lst)))
-- 
cgit v1.2.3