Subject: bug#76694: closed (Re: [bug#76694] [PATCH] packages: Honor system and target system for graft replacements.)

From: [email-masked] (GNU bug Tracking System)
Date: Sat, 08 Mar 2025 15:20:02 +0000

Your bug report

#76694: [PATCH] packages: Honor system and target system for graft replacements.

which was filed against the guix-patches package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
76694: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=76694
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: [bug#76694] [PATCH] packages: Honor system and target system for graft replacements.
From: Ludovic Courtès <[email-masked]>
To: David Elsing <[email-masked]>
Cc: [email-masked], [email-masked], Denis 'GNUtoo' Carikli <[email-masked]>
Date: Sat, 08 Mar 2025 16:18:23 +0100
List-Id: <debbugs-submit.debbugs.gnu.org>

Hi David,

David Elsing <[email-masked]> 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’.

Subject: [PATCH] packages: Honor system and target system for graft replacements.
From: David Elsing <[email-masked]>
To: [email-masked]
Cc: David Elsing <[email-masked]>
Date: Sun, 2 Mar 2025 22:43:30 +0000
List-Id: <debbugs-submit.debbugs.gnu.org>

* 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 <[email-masked]>
 ;;; Copyright © 2021 Maxime Devos <[email-masked]>
 ;;; Copyright © 2023 Simon Tournier <[email-masked]>
+;;; Copyright © 2025 David Elsing <[email-masked]>
 ;;;
 ;;; 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