mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
packages: Honor system and target system for graft replacements.
Fixes <https://issues.guix.gnu.org/76110>.
Fixes a regression introduced in
28e4018e59 where the system and target
system would be ignored.
* guix/packages.scm (input-graft, input-cross-graft): Wrap graft replacement
in ‘with-parameters’.
* tests/packages.scm ("package-grafts, indirect grafts")
("package-grafts, indirect grafts, propagated inputs")
("package-grafts, same replacement twice")
("package-grafts, dependency on several outputs")
("replacement also grafted"): Adjust accordingly by comparing the replacement
after lowering to a derivation.
("package-grafts, indirect grafts, #:system argument"): New test.
Change-Id: I1663f0cc50842bb9abb53ba4aa9935052022d1f4
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Reported-by: Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
This commit is contained in:
David Elsing
Ludovic Courtès
parent
5ead9fa56c
commit
70c7b4d7f0
2 changed files with 51 additions and 10 deletions
|
|
@ -1824,7 +1824,9 @@ graft, and #f otherwise."
|
|||
(return (graft
|
||||
(origin orig)
|
||||
(origin-output output)
|
||||
(replacement replacement)
|
||||
(replacement
|
||||
(with-parameters ((%current-system system))
|
||||
replacement))
|
||||
(replacement-output output))))
|
||||
package output system)
|
||||
(return #f))))
|
||||
|
|
@ -1846,7 +1848,10 @@ graft, and #f otherwise."
|
|||
(return (graft
|
||||
(origin orig)
|
||||
(origin-output output)
|
||||
(replacement replacement)
|
||||
(replacement
|
||||
(with-parameters ((%current-system system)
|
||||
(%current-target-system target))
|
||||
replacement))
|
||||
(replacement-output output))))
|
||||
(return #f))))
|
||||
(_
|
||||
|
|
|
|||
|
|
@ -4,6 +4,7 @@
|
|||
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
||||
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
|
||||
;;; Copyright © 2023 Simon Tournier <zimon.toutoune@gmail.com>
|
||||
;;; Copyright © 2025 David Elsing <david.elsing@posteo.net>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
|
@ -1095,7 +1096,29 @@
|
|||
((graft)
|
||||
(and (eq? (graft-origin graft)
|
||||
(package-derivation %store dep))
|
||||
(eq? (graft-replacement graft) new))))))
|
||||
(eq? (run-with-store %store
|
||||
(lower-object (graft-replacement graft)))
|
||||
(package-derivation %store new)))))))
|
||||
|
||||
(test-assert "package-grafts, indirect grafts, #:system argument"
|
||||
(let* ((system (if (string=? (%current-system) "riscv64-linux")
|
||||
"x86_64-linux"
|
||||
"riscv64-linux"))
|
||||
(new (dummy-package "dep"
|
||||
(arguments `(#:implicit-inputs? #f
|
||||
#:system ,system))))
|
||||
(dep (package (inherit new) (version "0.0")))
|
||||
(dep* (package (inherit dep) (replacement new)))
|
||||
(dummy (dummy-package "dummy"
|
||||
(arguments '(#:implicit-inputs? #f))
|
||||
(inputs (list dep*)))))
|
||||
(match (package-grafts %store dummy)
|
||||
((graft)
|
||||
(and (eq? (graft-origin graft)
|
||||
(package-derivation %store dep system))
|
||||
(eq? (run-with-store %store
|
||||
(lower-object (graft-replacement graft)))
|
||||
(package-derivation %store new)))))))
|
||||
|
||||
;; XXX: This test would require building the cross toolchain just to see if it
|
||||
;; needs grafting, which is obviously too expensive, and thus disabled.
|
||||
|
|
@ -1132,7 +1155,9 @@
|
|||
((graft)
|
||||
(and (eq? (graft-origin graft)
|
||||
(package-derivation %store dep))
|
||||
(eq? (graft-replacement graft) new))))))
|
||||
(eq? (run-with-store %store
|
||||
(lower-object (graft-replacement graft)))
|
||||
(package-derivation %store new)))))))
|
||||
|
||||
(test-assert "package-grafts, same replacement twice"
|
||||
(let* ((new (dummy-package "dep"
|
||||
|
|
@ -1157,7 +1182,9 @@
|
|||
(package-derivation %store
|
||||
(package (inherit dep)
|
||||
(replacement #f))))
|
||||
(eq? (graft-replacement graft) new))))))
|
||||
(eq? (run-with-store %store
|
||||
(lower-object (graft-replacement graft)))
|
||||
(package-derivation %store new)))))))
|
||||
|
||||
(test-assert "package-grafts, dependency on several outputs"
|
||||
;; Make sure we get one graft per output; see <https://bugs.gnu.org/41796>.
|
||||
|
|
@ -1177,9 +1204,11 @@
|
|||
((graft1 graft2)
|
||||
(and (eq? (graft-origin graft1) (graft-origin graft2)
|
||||
(package-derivation %store p0))
|
||||
(eq? (graft-replacement graft1)
|
||||
(graft-replacement graft2)
|
||||
p0*)
|
||||
(eq? (run-with-store %store
|
||||
(lower-object (graft-replacement graft1)))
|
||||
(run-with-store %store
|
||||
(lower-object (graft-replacement graft2)))
|
||||
(package-derivation %store p0*))
|
||||
(string=? "lib"
|
||||
(graft-origin-output graft1)
|
||||
(graft-replacement-output graft1))
|
||||
|
|
@ -1256,10 +1285,17 @@
|
|||
((graft1 graft2)
|
||||
(and (eq? (graft-origin graft1)
|
||||
(package-derivation %store p1 #:graft? #f))
|
||||
(eq? (graft-replacement graft1) p1r)
|
||||
(eq? (run-with-store %store
|
||||
(lower-object (graft-replacement graft1)))
|
||||
(package-derivation %store p1r #:graft? #t))
|
||||
(eq? (graft-origin graft2)
|
||||
(package-derivation %store p2 #:graft? #f))
|
||||
(eq? (graft-replacement graft2) p2r))))))
|
||||
;; XXX: Remove parameterize when
|
||||
;; <https://issues.guix.gnu.org/75879> is fixed.
|
||||
(eq? (parameterize ((%graft? #t))
|
||||
(run-with-store %store
|
||||
(lower-object (graft-replacement graft2))))
|
||||
(package-derivation %store p2r #:graft? #t)))))))
|
||||
|
||||
;;; XXX: Nowadays 'graft-derivation' needs to build derivations beforehand to
|
||||
;;; find out about their run-time dependencies, so this test is no longer
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue