summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-09-24 23:00:11 +0200
committerLudovic Courtès <ludo@gnu.org>2021-09-25 00:41:32 +0200
commitdf46bef48eaa43c502fa9193371692c039b460c1 (patch)
treebe496d3a0e8ff150ff8fc48c53f29c73e8f23867
parent9fbe4b88c2369166733bc039fb261839846011d3 (diff)
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.
-rw-r--r--guix/build-system/cmake.scm2
-rw-r--r--guix/build-system/glib-or-gtk.scm2
-rw-r--r--guix/build-system/gnu.scm4
-rw-r--r--guix/build-system/meson.scm2
-rw-r--r--guix/build-system/trivial.scm2
-rw-r--r--guix/gexp.scm17
-rw-r--r--tests/gexp.scm36
-rw-r--r--tests/packages.scm22
8 files changed, 77 insertions, 10 deletions
diff --git a/guix/build-system/cmake.scm b/guix/build-system/cmake.scm
index d500eccfde..2056c04153 100644
--- a/guix/build-system/cmake.scm
+++ b/guix/build-system/cmake.scm
@@ -158,6 +158,7 @@ provides a 'CMakeLists.txt' file as its build system."
(gexp->derivation name build
#:system system
#:target #f
+ #:graft? #f
#:substitutable? substitutable?
#:guile-for-build guile)))
@@ -248,6 +249,7 @@ build system."
(gexp->derivation name builder
#:system system
#:target target
+ #:graft? #f
#:substitutable? substitutable?
#:guile-for-build guile)))
diff --git a/guix/build-system/glib-or-gtk.scm b/guix/build-system/glib-or-gtk.scm
index ec491ff0bd..0c88f039d2 100644
--- a/guix/build-system/glib-or-gtk.scm
+++ b/guix/build-system/glib-or-gtk.scm
@@ -186,6 +186,7 @@
(gexp->derivation name build
#:system system
#:target #f
+ #:graft? #f
#:allowed-references allowed-references
#:disallowed-references disallowed-references
#:guile-for-build guile)))
@@ -279,6 +280,7 @@
(gexp->derivation name builder
#:system system
#:target target
+ #:graft? #f
#:modules imported-modules
#:allowed-references allowed-references
#:disallowed-references disallowed-references
diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index ea91be5bcd..651415098e 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -423,9 +423,12 @@ are allowed to refer to."
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
system #:graft? #f)))
+ ;; Note: Always pass #:graft? #f. Without it, ALLOWED-REFERENCES &
+ ;; co. would be interpreted as referring to grafted packages.
(gexp->derivation name builder
#:system system
#:target #f
+ #:graft? #f
#:substitutable? substitutable?
#:allowed-references allowed-references
#:disallowed-references disallowed-references
@@ -560,6 +563,7 @@ platform."
(gexp->derivation name builder
#:system system
#:target target
+ #:graft? #f
#:modules imported-modules
#:substitutable? substitutable?
#:allowed-references allowed-references
diff --git a/guix/build-system/meson.scm b/guix/build-system/meson.scm
index dcad3f322d..198aa08729 100644
--- a/guix/build-system/meson.scm
+++ b/guix/build-system/meson.scm
@@ -233,6 +233,7 @@ has a 'meson.build' file."
(gexp->derivation name builder
#:system system
#:target #f
+ #:graft? #f
#:substitutable? substitutable?
#:allowed-references allowed-references
#:disallowed-references disallowed-references
@@ -332,6 +333,7 @@ SOURCE has a 'meson.build' file."
(gexp->derivation name builder
#:system system
#:target target
+ #:graft? #f
#:substitutable? substitutable?
#:allowed-references allowed-references
#:disallowed-references disallowed-references
diff --git a/guix/build-system/trivial.scm b/guix/build-system/trivial.scm
index cd35c846ce..378ae481b9 100644
--- a/guix/build-system/trivial.scm
+++ b/guix/build-system/trivial.scm
@@ -61,6 +61,7 @@ ignored."
(gexp->derivation name (with-build-variables inputs outputs builder)
#:system system
#:target #f
+ #:graft? #f
#:modules modules
#:allowed-references allowed-references
#:guile-for-build guile)))
@@ -85,6 +86,7 @@ ignored."
builder)
#:system system
#:target target
+ #:graft? #f
#:modules modules
#:allowed-references allowed-references
#:guile-for-build guile)))
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)))
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
diff --git a/tests/packages.scm b/tests/packages.scm
index 46f4da1494..a9494b5c0e 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -882,6 +882,28 @@
(build-derivations %store (list d))
#f)))
+(test-assert "trivial with #:allowed-references + grafts"
+ (let* ((g (package
+ (inherit %bootstrap-guile)
+ (replacement (package
+ (inherit %bootstrap-guile)
+ (version "9.9")))))
+ (p (package
+ (inherit (dummy-package "trivial"))
+ (build-system trivial-build-system)
+ (inputs (list g))
+ (arguments
+ `(#:guile ,g
+ #:allowed-references (,g)
+ #:builder (mkdir %output)))))
+ (d0 (package-derivation %store p #:graft? #f))
+ (d1 (parameterize ((%graft? #t))
+ (package-derivation %store p #:graft? #t))))
+ ;; D1 should be equal to D2 because there's nothing to graft. In
+ ;; particular, its #:disallowed-references should be lowered in the same
+ ;; way (ungrafted) whether or not #:graft? is true.
+ (string=? (derivation-file-name d1) (derivation-file-name d0))))
+
(test-assert "search paths"
(let* ((p (make-prompt-tag "return-search-paths"))
(t (make-parameter "guile-0"))