GNU bug report logs - #76694
[PATCH] packages: Honor system and target system for graft replacements.

Previous Next

To reply to this bug, email your comments to 76694 AT debbugs.gnu.org.
There is no need to reopen the bug first.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: David Elsing <david.elsing <at> posteo.net>
To: guix-patches <at> gnu.org
Cc: David Elsing <david.elsing <at> posteo.net>
Subject: [PATCH] packages: Honor system and target system for graft
 replacements.
Date: Sun,  2 Mar 2025 22:43:30 +0000

* 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.
---
The modified tests are now more expensive, because comparing the
replacements now needs to be done by comparing the resulting derivations
due to the wrapping in <parameterized>. This requires building the
original package.

 guix/packages.scm  |  9 ++++++--
 tests/packages.scm | 52 +++++++++++++++++++++++++++++++++++++++-------
 2 files changed, 51 insertions(+), 10 deletions(-)

diff --git a/guix/packages.scm b/guix/packages.scm
index bdcea66f77..70ccd8a924 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1824,7 +1824,9 @@ (define (input-graft system)
                         (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 @@ (define (input-cross-graft target system)
                (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))))
       (_
diff --git a/tests/packages.scm b/tests/packages.scm
index 2863fb5991..50c1cab915 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
 ;;; Copyright © 2023 Simon Tournier <zimon.toutoune <at> gmail.com>
+;;; Copyright © 2025 David Elsing <david.elsing <at> posteo.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -1095,7 +1096,29 @@ (define right-system?
       ((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 @@ (define right-system?
       ((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 @@ (define right-system?
                  (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 @@ (define right-system?
       ((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 @@ (define right-system?
       ((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
-- 
2.48.1

Message #10 received at 76694-done <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: David Elsing <david.elsing <at> posteo.net>
Cc: 76694-done <at> debbugs.gnu.org, 76110-done <at> debbugs.gnu.org,
 Denis 'GNUtoo' Carikli <GNUtoo <at> cyberdimension.org>
Subject: Re: [bug#76694] [PATCH] packages: Honor system and target system
 for graft replacements.
Date: Sat, 08 Mar 2025 16:18:23 +0100

Hi David,

David Elsing <david.elsing <at> posteo.net> skribis:

> * 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.
> ---
> The modified tests are now more expensive, because comparing the
> replacements now needs to be done by comparing the resulting derivations
> due to the wrapping in <parameterized>. This requires building the
> original package.

Applied, thanks for fixing it!  I tweaked the commit log to include a
reference to the bug report and to the reporter.

Ludo’.

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.