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 @@ (define build (gexp->derivation name build #:system system #:target #f + #:graft? #f #:substitutable? substitutable? #:guile-for-build guile))) @@ -248,6 +249,7 @@ (define %outputs (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 @@ (define build (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 @@ (define %outputs (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 @@ (define builder (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 @@ (define %outputs (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 @@ (define build-phases (gexp->derivation name builder #:system system #:target #f + #:graft? #f #:substitutable? substitutable? #:allowed-references allowed-references #:disallowed-references disallowed-references @@ -332,6 +333,7 @@ (define build-phases (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 @@ (define* (trivial-build name inputs (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 @@ (define* (trivial-cross-build name 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 @@ (define tuple->gexp-input (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 @@ (define lower ((? string? output) (return output)) (($ 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 @@ (define (contents=? file str) (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 . + (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 @@ (define right-system? (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"))