me
/
guix
Archived
1
0
Fork 0
Code

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 a779363b6a 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
a779363b6a.
* 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.
master
Ludovic Courtès 2021-09-24 23:00:11 +02:00
parent 9fbe4b88c2
commit df46bef48e
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
8 changed files with 77 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
guix/build-system/cmake.scm
View File

@ -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)))

2
guix/build-system/glib-or-gtk.scm
View File

@ -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

4
guix/build-system/gnu.scm
View File

@ -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

2
guix/build-system/meson.scm
View File

@ -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

2
guix/build-system/trivial.scm
View File

@ -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)))

17
guix/gexp.scm
View File

@ -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)))

36
tests/gexp.scm
View File

@ -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

22
tests/packages.scm
View File

@ -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"))