diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/guix-build-branch.sh | 4 | ||||
| -rw-r--r-- | tests/guix-pack.sh | 12 | ||||
| -rw-r--r-- | tests/packages.scm | 59 | ||||
| -rw-r--r-- | tests/store.scm | 27 |
4 files changed, 94 insertions, 8 deletions
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 <ludo@gnu.org> +# Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> # # 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" 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 <cmmarusich@gmail.com> -# Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> # # 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" <<EOF (specifications->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` diff --git a/tests/packages.scm b/tests/packages.scm index 1ff35ec9c4..7a8b5e4a2d 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -109,6 +109,41 @@ (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, zero upgrades, propagated inputs" + ;; Properly detect equivalent packages even when they have propagated + ;; inputs. See <https://bugs.gnu.org/35872>. + (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"))) @@ -148,6 +183,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) 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" |