From a357849f5b1314c2a35efeee237645b9b08c39f5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 30 Mar 2020 23:34:48 +0200
Subject: [PATCH] guix package: Do not misdiagnose upgrades when there are
 propagated inputs.

Fixes <https://bugs.gnu.org/35872>.
Reported by Andy Tai <atai@atai.org>.

* guix/profiles.scm (list=?, manifest-entry=?): New procedures.
* guix/scripts/package.scm (transaction-upgrade-entry): In the '=' case,
use 'manifest-entry=?' to determine whether it's an upgrade.
* tests/packages.scm ("transaction-upgrade-entry, zero upgrades,
propagated inputs"): New test.
---
 guix/profiles.scm        | 29 +++++++++++++++++++++++++++++
 guix/scripts/package.scm | 11 +++--------
 tests/packages.scm       | 22 ++++++++++++++++++++++
 3 files changed, 54 insertions(+), 8 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index e3bbc6dd6d..8aa76a3537 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -89,6 +89,8 @@ (define-module (guix profiles)
             manifest-entry-properties
             lower-manifest-entry
 
+            manifest-entry=?
+
             manifest-pattern
             manifest-pattern?
             manifest-pattern-name
@@ -217,6 +219,33 @@ (define-record-type* <manifest-pattern> manifest-pattern
   (output       manifest-pattern-output           ; string | #f
                 (default "out")))
 
+(define (list=? = lst1 lst2)
+  "Return true if LST1 and LST2 have the same length and their elements are
+pairwise equal per =."
+  (match lst1
+    (()
+     (null? lst2))
+    ((head1 . tail1)
+     (match lst2
+       ((head2 . tail2)
+        (and (= head1 head2) (list=? = tail1 tail2)))
+       (()
+        #f)))))
+
+(define (manifest-entry=? entry1 entry2)
+  "Return true if ENTRY1 is equivalent to ENTRY2, ignoring their 'properties'
+field."
+  (match entry1
+    (($ <manifest-entry> name1 version1 output1 item1 dependencies1 paths1)
+     (match entry2
+       (($ <manifest-entry> name2 version2 output2 item2 dependencies2 paths2)
+        (and (string=? name1 name2)
+             (string=? version1 version2)
+             (string=? output1 output2)
+             (equal? item1 item2)      ;XXX: could be <package> vs. store item
+             (equal? paths1 paths2)
+             (list=? manifest-entry=? dependencies1 dependencies2)))))))
+
 (define (manifest-transitive-entries manifest)
   "Return the entries of MANIFEST along with their propagated inputs,
 recursively."
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index cafa62c3f3..badb1dcd38 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -240,14 +240,9 @@ (define (upgrade entry)
                     ;; displaying the list of packages to install/upgrade
                     ;; upfront.  Thus, if lowering NEW triggers a build (due
                     ;; to grafts), assume NEW differs from ENTRY.
-
-                    ;; XXX: When there are propagated inputs, assume we need to
-                    ;; upgrade the whole entry.
-                    (if (and (with-build-handler (const #f)
-                               (string=? (manifest-entry-item
-                                          (lower-manifest-entry* new))
-                                         (manifest-entry-item entry)))
-                             (null? (package-propagated-inputs pkg)))
+                    (if (with-build-handler (const #f)
+                          (manifest-entry=? (lower-manifest-entry* new)
+                                            entry))
                         transaction
                         (manifest-transaction-install-entry
                          new transaction)))))))))
diff --git a/tests/packages.scm b/tests/packages.scm
index d0befbe45d..7a8b5e4a2d 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -122,6 +122,28 @@ (define %store
                      (manifest-transaction)))))
     (manifest-transaction-null? tx)))
 
+(test-assert "transaction-upgrade-entry, zero upgrades, propagated inputs"
+  ;; Properly detect equivalent packages even when they have propagated
+  ;; inputs.  See <https://bugs.gnu.org/35872>.
+  (let* ((dep (dummy-package "dep" (version "2")))
+         (old (dummy-package "foo" (version "1")
+                             (propagated-inputs `(("dep" ,dep)))))
+         (drv (package-derivation %store old))
+         (tx  (mock ((gnu packages) find-best-packages-by-name
+                     (const (list old)))
+                    (transaction-upgrade-entry
+                     %store
+                     (manifest-entry
+                       (inherit (package->manifest-entry old))
+                       (item (derivation->output-path drv))
+                       (dependencies
+                        (list (manifest-entry
+                                (inherit (package->manifest-entry dep))
+                                (item (derivation->output-path
+                                       (package-derivation %store dep)))))))
+                     (manifest-transaction)))))
+    (manifest-transaction-null? tx)))
+
 (test-assert "transaction-upgrade-entry, one upgrade"
   (let* ((old (dummy-package "foo" (version "1")))
          (new (dummy-package "foo" (version "2")))