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') 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 v1.2.3 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') 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 v1.2.3 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') 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 v1.2.3 From b771e0176a9cafaaf5fc279a7f3e5e3033b5fb4f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 31 Mar 2020 00:05:02 +0200 Subject: pack: Adjust test to '--dry-run' changes. This is a followup to 131f50cdc9dbb7183023f4dae759876a9e700bef. * tests/guix-pack.sh: Use '--no-grafts' in conjunction with '-n' and '-d'. --- tests/guix-pack.sh | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'tests') diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh index 7a0f3400c3..14e3cda361 100644 --- a/tests/guix-pack.sh +++ b/tests/guix-pack.sh @@ -1,6 +1,6 @@ # GNU Guix --- Functional package management for GNU # Copyright © 2018 Chris Marusich -# Copyright © 2018, 2019 Ludovic Courtès +# Copyright © 2018, 2019, 2020 Ludovic Courtès # # This file is part of GNU Guix. # @@ -105,8 +105,8 @@ guix pack -R --dry-run --bootstrap -S /mybin=bin guile-bootstrap # Make sure package transformation options are honored. mkdir -p "$test_directory" -drv1="`guix pack -n guile 2>&1 | grep pack.*\.drv`" -drv2="`guix pack -n --with-source=guile=$test_directory guile 2>&1 | grep pack.*\.drv`" +drv1="`guix pack --no-grafts -n guile 2>&1 | grep pack.*\.drv`" +drv2="`guix pack --no-grafts -n --with-source=guile=$test_directory guile 2>&1 | grep pack.*\.drv`" test -n "$drv1" test "$drv1" != "$drv2" @@ -117,6 +117,6 @@ EOF cat > "$test_directory/manifest2.scm" <manifest '("emacs")) EOF -drv="`guix pack -nd -m "$test_directory/manifest1.scm" -m "$test_directory/manifest2.scm"`" -guix gc -R "$drv" | grep `guix build guile -nd` -guix gc -R "$drv" | grep `guix build emacs -nd` +drv="`guix pack --no-grafts -d -m "$test_directory/manifest1.scm" -m "$test_directory/manifest2.scm"`" +guix gc -R "$drv" | grep `guix build guile -d --no-grafts` +guix gc -R "$drv" | grep `guix build emacs -d --no-grafts` -- cgit v1.2.3 From 8ed597f4a261fe188de82cd1f5daed83dba948eb Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 4 Apr 2020 17:36:31 +0200 Subject: store: 'with-store' doesn't close the store upon abort. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes . Reported by Marius Bakke and 白い熊. Regression introduced with the first uses of 'with-build-handler' in commit 62195b9a8fd6846117c5d7698842748300d13e31 and subsequent. * guix/store.scm (call-with-store): Use 'catch #t' instead of 'dynamic-wind'. This ensures STORE remains open when a non-local exit other than an exception occurs, such as an abort to the build handler prompt. * tests/store.scm ("with-build-handler + with-store"): New test. --- guix/store.scm | 12 +++++++----- tests/store.scm | 27 +++++++++++++++++++++++++++ 2 files changed, 34 insertions(+), 5 deletions(-) (limited to 'tests') diff --git a/guix/store.scm b/guix/store.scm index ca8c0e5ef8..1dd5c9545b 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -623,14 +623,16 @@ connection. Use with care." (define (call-with-store proc) "Call PROC with an open store connection." (let ((store (open-connection))) - (dynamic-wind - (const #f) + (catch #t (lambda () (parameterize ((current-store-protocol-version (store-connection-version store))) - (proc store))) - (lambda () - (false-if-exception (close-connection store)))))) + (let ((result (proc store))) + (close-connection store) + result))) + (lambda (key . args) + (close-connection store) + (apply throw key args))))) (define-syntax-rule (with-store store exp ...) "Bind STORE to an open connection to the store and evaluate EXPs; diff --git a/tests/store.scm b/tests/store.scm index 0458a34746..0e80ccc239 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -412,6 +412,33 @@ (build-derivations %store (list d2)) 'fail))) +(test-equal "with-build-handler + with-store" + 'success + ;; Check that STORE remains valid when the build handler invokes CONTINUE, + ;; even though 'with-build-handler' is outside the dynamic extent of + ;; 'with-store'. + (with-build-handler (lambda (continue store things mode) + (match things + ((drv) + (and (string-suffix? "thingie.drv" drv) + (not (port-closed? + (store-connection-socket store))) + (continue #t))))) + (with-store store + (let* ((b (add-text-to-store store "build" "echo $foo > $out" '())) + (s (add-to-store store "bash" #t "sha256" + (search-bootstrap-binary "bash" + (%current-system)))) + (d (derivation store "thingie" + s `("-e" ,b) + #:env-vars `(("foo" . ,(random-text))) + #:sources (list b s)))) + (build-derivations store (list d)) + + ;; Here STORE's socket should still be open. + (and (valid-path? store (derivation->output-path d)) + 'success))))) + (test-assert "map/accumulate-builds" (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '())) (s (add-to-store %store "bash" #t "sha256" -- cgit v1.2.3 From 3cea55078857ecd8ca67fd7cf4eaebb13fb6d9d3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 4 Apr 2020 18:50:03 +0200 Subject: tests: Adjust '--with-commit' test for tags. This is a followup to efa578ecaece67366b4b0e2266de7c2faaa4ae54. * tests/guix-build-branch.sh: Adjust '--with-commit=guile-gcrypt=v0.1.0' test to expect the tag ID rather than the commit ID. --- tests/guix-build-branch.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'tests') diff --git a/tests/guix-build-branch.sh b/tests/guix-build-branch.sh index 2556a0cdb9..c5b07e07c6 100644 --- a/tests/guix-build-branch.sh +++ b/tests/guix-build-branch.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2018, 2019 Ludovic Courtès +# Copyright © 2018, 2019, 2020 Ludovic Courtès # # This file is part of GNU Guix. # @@ -54,7 +54,7 @@ test "$v0_1_0_drv" != "$orig_drv" v0_1_0_drv="`guix build guix --with-commit=guile-gcrypt=v0.1.0 -d`" guix gc -R "$v0_1_0_drv" | grep guile-gcrypt-0.1.0 -guix gc -R "$v0_1_0_drv" | grep guile-gcrypt-9e3eacd +guix gc -R "$v0_1_0_drv" | grep guile-gcrypt-8fe64e8 # this is the tag ID test "$v0_1_0_drv" != "$latest_drv" test "$v0_1_0_drv" != "$orig_drv" -- cgit v1.2.3