mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
gexp: Leave grafting as is when lowering allowed/disallowed references.
Fixes <https://issues.guix.gnu.org/50676>. Reported by Mathieu Othacehe <othacehe@gnu.org>. Commita779363b6a
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 revertsa779363b6a
. * 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.
This commit is contained in:
parent
9fbe4b88c2
commit
df46bef48e
8 changed files with 77 additions and 10 deletions
|
@ -158,6 +158,7 @@ (define build
|
||||||
(gexp->derivation name build
|
(gexp->derivation name build
|
||||||
#:system system
|
#:system system
|
||||||
#:target #f
|
#:target #f
|
||||||
|
#:graft? #f
|
||||||
#:substitutable? substitutable?
|
#:substitutable? substitutable?
|
||||||
#:guile-for-build guile)))
|
#:guile-for-build guile)))
|
||||||
|
|
||||||
|
@ -248,6 +249,7 @@ (define %outputs
|
||||||
(gexp->derivation name builder
|
(gexp->derivation name builder
|
||||||
#:system system
|
#:system system
|
||||||
#:target target
|
#:target target
|
||||||
|
#:graft? #f
|
||||||
#:substitutable? substitutable?
|
#:substitutable? substitutable?
|
||||||
#:guile-for-build guile)))
|
#:guile-for-build guile)))
|
||||||
|
|
||||||
|
|
|
@ -186,6 +186,7 @@ (define build
|
||||||
(gexp->derivation name build
|
(gexp->derivation name build
|
||||||
#:system system
|
#:system system
|
||||||
#:target #f
|
#:target #f
|
||||||
|
#:graft? #f
|
||||||
#:allowed-references allowed-references
|
#:allowed-references allowed-references
|
||||||
#:disallowed-references disallowed-references
|
#:disallowed-references disallowed-references
|
||||||
#:guile-for-build guile)))
|
#:guile-for-build guile)))
|
||||||
|
@ -279,6 +280,7 @@ (define %outputs
|
||||||
(gexp->derivation name builder
|
(gexp->derivation name builder
|
||||||
#:system system
|
#:system system
|
||||||
#:target target
|
#:target target
|
||||||
|
#:graft? #f
|
||||||
#:modules imported-modules
|
#:modules imported-modules
|
||||||
#:allowed-references allowed-references
|
#:allowed-references allowed-references
|
||||||
#:disallowed-references disallowed-references
|
#:disallowed-references disallowed-references
|
||||||
|
|
|
@ -423,9 +423,12 @@ (define builder
|
||||||
|
|
||||||
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
|
(mlet %store-monad ((guile (package->derivation (or guile (default-guile))
|
||||||
system #:graft? #f)))
|
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
|
(gexp->derivation name builder
|
||||||
#:system system
|
#:system system
|
||||||
#:target #f
|
#:target #f
|
||||||
|
#:graft? #f
|
||||||
#:substitutable? substitutable?
|
#:substitutable? substitutable?
|
||||||
#:allowed-references allowed-references
|
#:allowed-references allowed-references
|
||||||
#:disallowed-references disallowed-references
|
#:disallowed-references disallowed-references
|
||||||
|
@ -560,6 +563,7 @@ (define %outputs
|
||||||
(gexp->derivation name builder
|
(gexp->derivation name builder
|
||||||
#:system system
|
#:system system
|
||||||
#:target target
|
#:target target
|
||||||
|
#:graft? #f
|
||||||
#:modules imported-modules
|
#:modules imported-modules
|
||||||
#:substitutable? substitutable?
|
#:substitutable? substitutable?
|
||||||
#:allowed-references allowed-references
|
#:allowed-references allowed-references
|
||||||
|
|
|
@ -233,6 +233,7 @@ (define build-phases
|
||||||
(gexp->derivation name builder
|
(gexp->derivation name builder
|
||||||
#:system system
|
#:system system
|
||||||
#:target #f
|
#:target #f
|
||||||
|
#:graft? #f
|
||||||
#:substitutable? substitutable?
|
#:substitutable? substitutable?
|
||||||
#:allowed-references allowed-references
|
#:allowed-references allowed-references
|
||||||
#:disallowed-references disallowed-references
|
#:disallowed-references disallowed-references
|
||||||
|
@ -332,6 +333,7 @@ (define build-phases
|
||||||
(gexp->derivation name builder
|
(gexp->derivation name builder
|
||||||
#:system system
|
#:system system
|
||||||
#:target target
|
#:target target
|
||||||
|
#:graft? #f
|
||||||
#:substitutable? substitutable?
|
#:substitutable? substitutable?
|
||||||
#:allowed-references allowed-references
|
#:allowed-references allowed-references
|
||||||
#:disallowed-references disallowed-references
|
#:disallowed-references disallowed-references
|
||||||
|
|
|
@ -61,6 +61,7 @@ (define* (trivial-build name inputs
|
||||||
(gexp->derivation name (with-build-variables inputs outputs builder)
|
(gexp->derivation name (with-build-variables inputs outputs builder)
|
||||||
#:system system
|
#:system system
|
||||||
#:target #f
|
#:target #f
|
||||||
|
#:graft? #f
|
||||||
#:modules modules
|
#:modules modules
|
||||||
#:allowed-references allowed-references
|
#:allowed-references allowed-references
|
||||||
#:guile-for-build guile)))
|
#:guile-for-build guile)))
|
||||||
|
@ -85,6 +86,7 @@ (define* (trivial-cross-build name
|
||||||
builder)
|
builder)
|
||||||
#:system system
|
#:system system
|
||||||
#:target target
|
#:target target
|
||||||
|
#:graft? #f
|
||||||
#:modules modules
|
#:modules modules
|
||||||
#:allowed-references allowed-references
|
#:allowed-references allowed-references
|
||||||
#:guile-for-build guile)))
|
#:guile-for-build guile)))
|
||||||
|
|
|
@ -923,9 +923,8 @@ (define tuple->gexp-input
|
||||||
|
|
||||||
(match graphs
|
(match graphs
|
||||||
(((file-names . inputs) ...)
|
(((file-names . inputs) ...)
|
||||||
(mlet %store-monad ((inputs (without-grafting
|
(mlet %store-monad ((inputs (lower-inputs (map tuple->gexp-input inputs)
|
||||||
(lower-inputs (map tuple->gexp-input inputs)
|
system target)))
|
||||||
system target))))
|
|
||||||
(return (map cons file-names inputs))))))
|
(return (map cons file-names inputs))))))
|
||||||
|
|
||||||
(define* (lower-references lst #:key system target)
|
(define* (lower-references lst #:key system target)
|
||||||
|
@ -938,15 +937,13 @@ (define lower
|
||||||
((? string? output)
|
((? string? output)
|
||||||
(return output))
|
(return output))
|
||||||
(($ <gexp-input> thing output native?)
|
(($ <gexp-input> thing output native?)
|
||||||
(mlet %store-monad ((drv (without-grafting
|
(mlet %store-monad ((drv (lower-object thing system
|
||||||
(lower-object thing system
|
|
||||||
#:target (if native?
|
#:target (if native?
|
||||||
#f target)))))
|
#f target))))
|
||||||
(return (derivation->output-path drv output))))
|
(return (derivation->output-path drv output))))
|
||||||
(thing
|
(thing
|
||||||
(mlet %store-monad ((drv (without-grafting
|
(mlet %store-monad ((drv (lower-object thing system
|
||||||
(lower-object thing system
|
#:target target)))
|
||||||
#:target target))))
|
|
||||||
(return (derivation->output-path drv))))))
|
(return (derivation->output-path drv))))))
|
||||||
|
|
||||||
(mapm/accumulate-builds lower lst)))
|
(mapm/accumulate-builds lower lst)))
|
||||||
|
|
|
@ -1475,6 +1475,42 @@ (define (contents=? file str)
|
||||||
(string=? (readlink (string-append comp "/text"))
|
(string=? (readlink (string-append comp "/text"))
|
||||||
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"
|
(test-equal "lower-object, computed-file, #:system"
|
||||||
'("mips64el-linux")
|
'("mips64el-linux")
|
||||||
(run-with-store %store
|
(run-with-store %store
|
||||||
|
|
|
@ -882,6 +882,28 @@ (define right-system?
|
||||||
(build-derivations %store (list d))
|
(build-derivations %store (list d))
|
||||||
#f)))
|
#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"
|
(test-assert "search paths"
|
||||||
(let* ((p (make-prompt-tag "return-search-paths"))
|
(let* ((p (make-prompt-tag "return-search-paths"))
|
||||||
(t (make-parameter "guile-0"))
|
(t (make-parameter "guile-0"))
|
||||||
|
|
Loading…
Reference in a new issue