From mboxrd@z Thu Jan 1 00:00:00 1970 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Subject: bug#35872: messages that are redundant can be eliminated? Date: Tue, 24 Mar 2020 23:02:48 +0100 Message-ID: <87y2rpjtrr.fsf@gnu.org> References: <87zhnbrdvc.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:470:142:3::10]:41054) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jGrdX-0007r2-Bd for bug-guix@gnu.org; Tue, 24 Mar 2020 18:03:04 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1jGrdV-0007EX-Tj for bug-guix@gnu.org; Tue, 24 Mar 2020 18:03:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:49727) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1jGrdV-0007EQ-QR for bug-guix@gnu.org; Tue, 24 Mar 2020 18:03:01 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jGrdV-0006wg-Mz for bug-guix@gnu.org; Tue, 24 Mar 2020 18:03:01 -0400 Sender: "Debbugs-submit" Resent-Message-ID: In-Reply-To: <87zhnbrdvc.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Fri, 24 May 2019 18:55:35 +0200") List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+gcggb-bug-guix=m.gmane-mx.org@gnu.org Sender: "bug-Guix" To: Andy Tai Cc: 35872@debbugs.gnu.org --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable (+Cc: Efraim following our discussion on IRC.) Ludovic Court=C3=A8s skribis: > This is a bug where the presence of propagated inputs leads =E2=80=98guix > upgrade=E2=80=99 to assume something would be upgraded, even when that=E2= =80=99s 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 =E2=80=98guix upgrade=E2=80=99 to correctly determine whether s= omething is going to be upgraded. But then I realized that this cannot work in the presence of grafts: first because =E2=80=98-n=E2=80=99 currently implies =E2=80=98--no-grafts= =E2=80=99, 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 =E2=80=9Cdyn= amic dependencies=E2=80=9D.) So I=E2=80=99m willing to punt for now. I wonder if there=E2=80=99s a UI trick we could use to avoid displaying too= many =E2=80=9C(dependencies changed)=E2=80=9D though. Thoughts? Ludo=E2=80=99. --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable 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 =C2=A9 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Cour= t=C3=A8s +;;; Copyright =C2=A9 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovi= c Court=C3=A8s ;;; Copyright =C2=A9 2013 Nikita Karetnikov ;;; Copyright =C2=A9 2014, 2016 Alex Kost ;;; Copyright =C2=A9 2015 Mark H Weaver @@ -87,6 +87,7 @@ manifest-entry-search-paths manifest-entry-parent manifest-entry-properties + manifest-entry=3D? =20 manifest-pattern manifest-pattern? @@ -216,6 +217,32 @@ (output manifest-pattern-output ; string | #f (default "out"))) =20 +(define (list=3D? =3D lst1 lst2) + "Return true if LST1 and LST2 have the same length and their elements are +pairwise equal per =3D." + (match lst1 + (() + (null? lst2)) + ((head1 . tail1) + (match lst2 + ((head2 . tail2) + (and (=3D head1 head2) (list=3D? =3D tail1 tail2))) + (() + #f))))) + +(define (manifest-entry=3D? entry1 entry2) + "Return true if ENTRY1 is equivalent to ENTRY2." + (match entry1 + (($ name1 version1 output1 item1 dependencies1 paths1) + (match entry2 + (($ name2 version2 output2 item2 dependencies2 pat= hs2) + (and (string=3D? name1 name2) + (string=3D? version1 version2) + (string=3D? output1 output2) + (equal? item1 item2) ;XXX: could be vs. store = item + (equal? paths1 paths2) + (list=3D? manifest-entry=3D? 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)))))))))) =20 +(define (lower-manifest-entry store entry) + "Lower entry by replacing its package objects with their corresponding s= tore +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 ." @@ -215,40 +228,37 @@ non-zero relevance score." (output (manifest-entry-output old))) transaction))) =20 - (match (if (manifest-transaction-removal-candidate? entry transaction) - 'dismiss - entry) - ('dismiss - transaction) - (($ 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) - ((=3D) - (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=3D? 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 + (($ 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) + ((=3D) + (let* ((new (package->manifest-entry* pkg output))) + (if (manifest-entry=3D? (lower-manifest-entry store ne= w) + 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))) =20 ;;; --=-=-=--