summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-03-30 22:11:54 +0200
committerLudovic Courtès <ludo@gnu.org>2020-03-31 00:06:36 +0200
commita187cc562890895ad41dfad00eb1d5c4a4b00936 (patch)
treeff690f391b51cd4b6fd4c6389e3d913c4b6c73dc
parent190ddfe21e3d87719733d12fb9b5eb176125a49f (diff)
downloadguix-a187cc562890895ad41dfad00eb1d5c4a4b00936.tar.gz
guix package: 'transaction-upgrade-entry' swallows build requests.
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.
-rw-r--r--guix/scripts/package.scm14
-rw-r--r--tests/packages.scm24
2 files changed, 35 insertions, 3 deletions
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index be2e67997e..cafa62c3f3 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -234,11 +234,19 @@ non-zero relevance score."
                   transaction)
                  ((=)
                   (let* ((new (package->manifest-entry* pkg output)))
+                    ;; Here we want to determine whether the NEW actually
+                    ;; differs from ENTRY, but we need to intercept
+                    ;; 'build-things' calls because they would prevent us from
+                    ;; 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 (string=? (manifest-entry-item
-                                        (lower-manifest-entry* new))
-                                       (manifest-entry-item 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)))
                         transaction
                         (manifest-transaction-install-entry
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)
+               ((($ <manifest-entry> "foo" "1" "out" item))
+                (eq? item new)))
+             (null? (manifest-transaction-remove tx)))))))
+
 (test-assert "package-field-location"
   (let ()
     (define (goto port line column)