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.
---
 tests/gexp.scm | 36 ++++++++++++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)

(limited to 'tests/gexp.scm')

diff --git a/tests/gexp.scm b/tests/gexp.scm
index 709a198e1e..28d09f5a6d 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1475,6 +1475,42 @@ importing.* \\(guix config\\) from the host"
                      (string=? (readlink (string-append comp "/text"))
                                text)))))))
 
+(test-assert "lower-object, computed-file + grafts"
+  ;; The reference graph should refer to grafted packages when grafts are
+  ;; enabled.  See <https://issues.guix.gnu.org/50676>.
+  (let* ((base    (package
+                    (inherit (dummy-package "trivial"))
+                    (build-system trivial-build-system)
+                    (arguments
+                     `(#:guile ,%bootstrap-guile
+                       #:builder (mkdir %output)))))
+         (pkg     (package
+                    (inherit base)
+                    (version "1.1")
+                    (replacement (package
+                                   (inherit base)
+                                   (version "9.9")))))
+         (exp      #~(begin
+                       (use-modules (ice-9 rdelim))
+                       (let ((item (call-with-input-file "graph" read-line)))
+                         (call-with-output-file #$output
+                           (lambda (port)
+                             (display item port))))))
+         (computed (computed-file "computed" exp
+                                  #:options
+                                  `(#:references-graphs (("graph" ,pkg)))))
+         (drv0     (package-derivation %store pkg #:graft? #t))
+         (drv1     (parameterize ((%graft? #t))
+                     (run-with-store %store
+                       (lower-object computed)))))
+    (build-derivations %store (list drv1))
+
+    ;; The graph obtained in COMPUTED should refer to the grafted version of
+    ;; PKG, not to PKG itself.
+    (string=? (call-with-input-file (derivation->output-path drv1)
+                get-string-all)
+              (derivation->output-path drv0))))
+
 (test-equal "lower-object, computed-file, #:system"
   '("mips64el-linux")
   (run-with-store %store
-- 
cgit v1.2.3