From a187cc562890895ad41dfad00eb1d5c4a4b00936 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 30 Mar 2020 22:11:54 +0200 Subject: guix package: 'transaction-upgrade-entry' swallows build requests. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes a regression introduced in 131f50cdc9dbb7183023f4dae759876a9e700bef whereby the install/upgrade message would not be displayed: $ guix upgrade -n 2.1 MB would be downloaded: /gnu/store/…-something-1.2 /gnu/store/…-its-dependency-2.3 This is because we'd directly abort from 'transaction-upgrade-entry' to the build handler of 'build-notifier'. * guix/scripts/package.scm (transaction-upgrade-entry): Call 'string=?' expression in 'with-build-handler'. * tests/packages.scm ("transaction-upgrade-entry, grafts"): New test. --- tests/packages.scm | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) (limited to 'tests/packages.scm') diff --git a/tests/packages.scm b/tests/packages.scm index 1ff35ec9c4..c2ec1f2c24 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -148,6 +148,30 @@ (string=? (manifest-pattern-version pattern) "1") (string=? (manifest-pattern-output pattern) "out"))))))) +(test-assert "transaction-upgrade-entry, grafts" + ;; Ensure that, when grafts are enabled, 'transaction-upgrade-entry' doesn't + ;; try to build stuff. + (with-build-handler (const 'failed!) + (parameterize ((%graft? #t)) + (let* ((old (dummy-package "foo" (version "1"))) + (bar (dummy-package "bar" (version "0") + (replacement old))) + (new (dummy-package "foo" (version "1") + (inputs `(("bar" ,bar))))) + (tx (mock ((gnu packages) find-best-packages-by-name + (const (list new))) + (transaction-upgrade-entry + %store + (manifest-entry + (inherit (package->manifest-entry old)) + (item (string-append (%store-prefix) "/" + (make-string 32 #\e) "-foo-1"))) + (manifest-transaction))))) + (and (match (manifest-transaction-install tx) + ((($ "foo" "1" "out" item)) + (eq? item new))) + (null? (manifest-transaction-remove tx))))))) + (test-assert "package-field-location" (let () (define (goto port line column) -- cgit 1.4.1 From b9c79cae53f5f828e078ac5aafc2d80fa3204aae Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 30 Mar 2020 23:19:38 +0200 Subject: guix package: Add 'transaction-upgrade-entry' test. * tests/packages.scm ("transaction-upgrade-entry, zero upgrades, equivalent package"): New test. --- tests/packages.scm | 13 +++++++++++++ 1 file changed, 13 insertions(+) (limited to 'tests/packages.scm') diff --git a/tests/packages.scm b/tests/packages.scm index c2ec1f2c24..d0befbe45d 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -109,6 +109,19 @@ (manifest-transaction))))) (manifest-transaction-null? tx))) +(test-assert "transaction-upgrade-entry, zero upgrades, equivalent package" + (let* ((old (dummy-package "foo" (version "1"))) + (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))) + (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"))) -- cgit 1.4.1 From a357849f5b1314c2a35efeee237645b9b08c39f5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 30 Mar 2020 23:34:48 +0200 Subject: guix package: Do not misdiagnose upgrades when there are propagated inputs. Fixes . Reported by Andy Tai . * 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(-) (limited to 'tests/packages.scm') 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 @@ manifest-entry-properties lower-manifest-entry + manifest-entry=? + manifest-pattern manifest-pattern? manifest-pattern-name @@ -217,6 +219,33 @@ (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 + (($ name1 version1 output1 item1 dependencies1 paths1) + (match entry2 + (($ name2 version2 output2 item2 dependencies2 paths2) + (and (string=? name1 name2) + (string=? version1 version2) + (string=? output1 output2) + (equal? item1 item2) ;XXX: could be 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 @@ non-zero relevance score." ;; 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 @@ (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 . + (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"))) -- cgit 1.4.1