From 8db4ebb0cd9bfdcf1aea63eb8d20eb6af0c87c93 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 20 Oct 2020 09:18:07 +0200
Subject: packages: Better preserve object identity when rewriting.

Fixes a bug whereby the presence of propagated inputs could lead to two
non-eq? but actually equal packages in a bag's inputs.  The problem
would manifest itself when running, for instance:

  guix build inkscape -d --with-graft=glib=glib-networking --no-grafts

The resulting derivation would differ due from that without
'--with-graft'.  This was due to the fact that glib propagates libffi;
this instance of libffi was not rewritten even though other instances in
the graph were rewritten.  Thus, glib would end up with two non-eq?
libffi instances, which in turn would lead to duplicate entries in its
'%build-inputs' variable.

Fixes <https://bugs.gnu.org/43890>.

* guix/packages.scm (package-mapping)[rewrite]: Remove call to 'cut?'
and call 'replace' unconditionally.
[replace]: Add 'cut?' case.
* tests/guix-build.sh: Add test combining '--no-grafts' and
'--with-graft'.
* tests/packages.scm ("package-input-rewriting/spec, identity")
("package-input-rewriting, identity"): New tests.
---
 guix/packages.scm | 63 ++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 39 insertions(+), 24 deletions(-)

(limited to 'guix')

diff --git a/guix/packages.scm b/guix/packages.scm
index 24d6417065..6fa761f569 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1015,8 +1015,7 @@ applied to implicit inputs as well."
   (define (rewrite input)
     (match input
       ((label (? package? package) outputs ...)
-       (let ((proc (if (cut? package) proc replace)))
-         (cons* label (proc package) outputs)))
+       (cons* label (replace package) outputs))
       (_
        input)))
 
@@ -1027,28 +1026,44 @@ applied to implicit inputs as well."
   (define replace
     (mlambdaq (p)
       ;; If P is the result of a previous call, return it.
-      (if (assq-ref (package-properties p) mapping-property)
-          p
-
-          ;; Return a variant of P with PROC applied to P and its explicit
-          ;; dependencies, recursively.  Memoize the transformations.  Failing
-          ;; to do that, we would build a huge object graph with lots of
-          ;; duplicates, which in turns prevents us from benefiting from
-          ;; memoization in 'package-derivation'.
-          (let ((p (proc p)))
-            (package
-              (inherit p)
-              (location (package-location p))
-              (build-system (if deep?
-                                (build-system-with-package-mapping
-                                 (package-build-system p) rewrite)
-                                (package-build-system p)))
-              (inputs (map rewrite (package-inputs p)))
-              (native-inputs (map rewrite (package-native-inputs p)))
-              (propagated-inputs (map rewrite (package-propagated-inputs p)))
-              (replacement (and=> (package-replacement p) replace))
-              (properties `((,mapping-property . #t)
-                            ,@(package-properties p))))))))
+      (cond ((assq-ref (package-properties p) mapping-property)
+             p)
+
+            ((cut? p)
+             ;; Since P's propagated inputs are really inputs of its dependents,
+             ;; rewrite them as well, unless we're doing a "shallow" rewrite.
+             (let ((p (proc p)))
+               (if (or (not deep?)
+                       (null? (package-propagated-inputs p)))
+                   p
+                   (package
+                     (inherit p)
+                     (location (package-location p))
+                     (replacement (package-replacement p))
+                     (propagated-inputs (map rewrite (package-propagated-inputs p)))
+                     (properties `((,mapping-property . #t)
+                                   ,@(package-properties p)))))))
+
+            (else
+             ;; Return a variant of P with PROC applied to P and its explicit
+             ;; dependencies, recursively.  Memoize the transformations.  Failing
+             ;; to do that, we would build a huge object graph with lots of
+             ;; duplicates, which in turns prevents us from benefiting from
+             ;; memoization in 'package-derivation'.
+             (let ((p (proc p)))
+               (package
+                 (inherit p)
+                 (location (package-location p))
+                 (build-system (if deep?
+                                   (build-system-with-package-mapping
+                                    (package-build-system p) rewrite)
+                                   (package-build-system p)))
+                 (inputs (map rewrite (package-inputs p)))
+                 (native-inputs (map rewrite (package-native-inputs p)))
+                 (propagated-inputs (map rewrite (package-propagated-inputs p)))
+                 (replacement (and=> (package-replacement p) replace))
+                 (properties `((,mapping-property . #t)
+                               ,@(package-properties p)))))))))
 
   replace)
 
-- 
cgit v1.2.3