GNU bug report logs - #35872
'guix upgrade' misdiagnoses upgrades in the presence of propagated inputs

Previous Next

Full log

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

From: Ludovic Courtès <ludo <at> gnu.org>
To: Andy Tai <atai <at> atai.org>
Cc: 35872 <at> debbugs.gnu.org, Efraim Flashner <efraim <at> flashner.co.il>
Subject: Re: bug#35872: messages that are redundant can be eliminated?
Date: Tue, 24 Mar 2020 23:02:48 +0100

[Message part 1 (text/plain, inline)]

(+Cc: Efraim following our discussion on IRC.)

Ludovic Courtès <ludo <at> gnu.org> skribis:

> This is a bug where the presence of propagated inputs leads ‘guix
> upgrade’ to assume something would be upgraded, even when that’s not the
> case.  This can be reproduced with:
>
>   guix install -p foo guile
>   guix upgrade -p foo

I came up with an actual fix for that (attached), nice and clean, which
would allow ‘guix upgrade’ to correctly determine whether something is
going to be upgraded.

But then I realized that this cannot work in the presence of grafts:
first because ‘-n’ currently implies ‘--no-grafts’, so this is an apple
to orange comparison, and then because computing the output file name of
a grafted package can require building the package (grafts are “dynamic
dependencies”.)

So I’m willing to punt for now.

I wonder if there’s a UI trick we could use to avoid displaying too many
“(dependencies changed)” though.

Thoughts?

Ludo’.

[Message part 2 (text/x-patch, inline)]

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 20a2973579..cb95969926 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita <at> karetnikov.org>
 ;;; Copyright © 2014, 2016 Alex Kost <alezost <at> gmail.com>
 ;;; Copyright © 2015 Mark H Weaver <mhw <at> netris.org>
@@ -87,6 +87,7 @@
             manifest-entry-search-paths
             manifest-entry-parent
             manifest-entry-properties
+            manifest-entry=?
 
             manifest-pattern
             manifest-pattern?
@@ -216,6 +217,32 @@
   (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."
+  (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 b5d16acec0..0650ec965c 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -200,6 +200,19 @@ non-zero relevance score."
                                 (package-full-name package2))
                       (> score1 score2))))))))))
 
+(define (lower-manifest-entry store entry)
+  "Lower entry by replacing its package objects with their corresponding store
+item, recursively."
+  (let* ((output (manifest-entry-output entry))
+         (item   (derivation->output-path
+                  (package-derivation store (manifest-entry-item entry))
+                  output)))
+    (manifest-entry
+      (inherit entry)
+      (item item)
+      (dependencies (map (cut lower-manifest-entry store <>)
+                         (manifest-entry-dependencies entry))))))
+
 (define (transaction-upgrade-entry store entry transaction)
   "Return a variant of TRANSACTION that accounts for the upgrade of ENTRY, a
 <manifest-entry>."
@@ -215,40 +228,37 @@ non-zero relevance score."
         (output (manifest-entry-output old)))
       transaction)))
 
-  (match (if (manifest-transaction-removal-candidate? entry transaction)
-             'dismiss
-             entry)
-    ('dismiss
-     transaction)
-    (($ <manifest-entry> name version output (? string? path))
-     (match (find-best-packages-by-name name #f)
-       ((pkg . rest)
-        (let ((candidate-version (package-version pkg)))
-          (match (package-superseded pkg)
-            ((? package? new)
-             (supersede entry new))
-            (#f
-             (case (version-compare candidate-version version)
-               ((>)
-                (manifest-transaction-install-entry
-                 (package->manifest-entry* pkg output)
-                 transaction))
-               ((<)
-                transaction)
-               ((=)
-                (let ((candidate-path (derivation->output-path
-                                       (package-derivation store pkg))))
-                  ;; XXX: When there are propagated inputs, assume we need to
-                  ;; upgrade the whole entry.
-                  (if (and (string=? path candidate-path)
-                           (null? (package-propagated-inputs pkg)))
-                      transaction
-                      (manifest-transaction-install-entry
-                       (package->manifest-entry* pkg output)
-                       transaction)))))))))
-       (()
-        (warning (G_ "package '~a' no longer exists~%") name)
-        transaction)))))
+  (define (upgrade entry)
+    (match entry
+      (($ <manifest-entry> name version output (? string? path))
+       (match (find-best-packages-by-name name #f)
+         ((pkg . rest)
+          (let ((candidate-version (package-version pkg)))
+            (match (package-superseded pkg)
+              ((? package? new)
+               (supersede entry new))
+              (#f
+               (case (version-compare candidate-version version)
+                 ((>)
+                  (manifest-transaction-install-entry
+                   (package->manifest-entry* pkg output)
+                   transaction))
+                 ((<)
+                  transaction)
+                 ((=)
+                  (let* ((new (package->manifest-entry* pkg output)))
+                    (if (manifest-entry=? (lower-manifest-entry store new)
+                                          entry)
+                        transaction
+                        (manifest-transaction-install-entry
+                         new transaction)))))))))
+         (()
+          (warning (G_ "package '~a' no longer exists~%") name)
+          transaction)))))
+
+  (if (manifest-transaction-removal-candidate? entry transaction)
+      entry
+      (upgrade entry)))
 
 
 ;;;

Previous Next

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