[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#35872: messages that are redundant can be eliminated?
From: |
Ludovic Courtès |
Subject: |
bug#35872: messages that are redundant can be eliminated? |
Date: |
Tue, 24 Mar 2020 23:02:48 +0100 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) |
(+Cc: Efraim following our discussion on IRC.)
Ludovic Courtès <address@hidden> 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’.
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
<address@hidden>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès
<address@hidden>
;;; Copyright © 2013 Nikita Karetnikov <address@hidden>
;;; Copyright © 2014, 2016 Alex Kost <address@hidden>
;;; Copyright © 2015 Mark H Weaver <address@hidden>
@@ -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)))
;;;