aboutsummaryrefslogtreecommitdiff
path: root/tests/packages.scm
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 /tests/packages.scm
parent190ddfe21e3d87719733d12fb9b5eb176125a49f (diff)
downloadpatches-a187cc562890895ad41dfad00eb1d5c4a4b00936.tar
patches-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.
Diffstat (limited to 'tests/packages.scm')
-rw-r--r--tests/packages.scm24
1 files changed, 24 insertions, 0 deletions
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)