Merge branch 'master' into staging

10 files changed, 172 insertions, 33 deletions

diff --git a/tests/crate.scm b/tests/crate.scm
index aa51faebf9..61a04f986b 100644
--- a/tests/crate.scm
+++ b/tests/crate.scm
@@ -55,7 +55,7 @@
   \"dependencies\": [
      {
        \"crate_id\": \"bar\",
-       \"kind\": \"normal\",
+       \"kind\": \"normal\"
      }
   ]
 }")
@@ -87,20 +87,20 @@
   \"dependencies\": [
      {
        \"crate_id\": \"intermediate-1\",
-       \"kind\": \"normal\",
+       \"kind\": \"normal\"
      },
      {
        \"crate_id\": \"intermediate-2\",
-       \"kind\": \"normal\",
+       \"kind\": \"normal\"
      }
      {
        \"crate_id\": \"leaf-alice\",
-       \"kind\": \"normal\",
+       \"kind\": \"normal\"
      },
      {
        \"crate_id\": \"leaf-bob\",
-       \"kind\": \"normal\",
-     },
+       \"kind\": \"normal\"
+     }
   ]
 }")
 
@@ -131,15 +131,15 @@
   \"dependencies\": [
      {
        \"crate_id\": \"intermediate-2\",
-       \"kind\": \"normal\",
+       \"kind\": \"normal\"
      },
      {
        \"crate_id\": \"leaf-alice\",
-       \"kind\": \"normal\",
+       \"kind\": \"normal\"
      },
      {
        \"crate_id\": \"leaf-bob\",
-       \"kind\": \"normal\",
+       \"kind\": \"normal\"
      }
   ]
 }")
@@ -171,8 +171,8 @@
   \"dependencies\": [
      {
        \"crate_id\": \"leaf-bob\",
-       \"kind\": \"normal\",
-     },
+       \"kind\": \"normal\"
+     }
   ]
 }")
 
@@ -233,6 +233,7 @@
 (define test-source-hash
   "")
 
+
 (test-begin "crate")
 
 (test-equal "guix-package->crate-name"
diff --git a/tests/gem.scm b/tests/gem.scm
index 455fc15189..751bba656f 100644
--- a/tests/gem.scm
+++ b/tests/gem.scm
@@ -52,7 +52,7 @@
   \"homepage_uri\": \"https://example.com\",
   \"dependencies\": {
     \"runtime\": [
-      { \"name\": \"bundler\" },
+      { \"name\": \"bundler\" }
     ]
   },
   \"licenses\": null
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-relocatable.sh b/tests/guix-pack-relocatable.sh
index e93610eedc..a3fd45623c 100644
--- a/tests/guix-pack-relocatable.sh
+++ b/tests/guix-pack-relocatable.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.
 #
@@ -72,6 +72,10 @@ then
     # mounting an empty file system on top of it.  That way, we exercise the
     # wrapper code that creates the user namespace and bind-mounts the store.
     unshare -mrf sh -c 'mount -t tmpfs none "$STORE_PARENT"; echo "$STORE_PARENT"/*; "$test_directory/Bin/sed" --version > "$test_directory/output"'
+
+    # Check whether the exit code is preserved.
+    if unshare -mrf sh -c 'mount -t tmpfs none "$STORE_PARENT"; echo "$STORE_PARENT"/*; "$test_directory/Bin/sed" --does-not-exist';
+    then false; else true; fi
 else
     # Run the relocatable 'sed' in the current namespaces.  This is a weak
     # test because we're going to access store items from the host store.
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/print.scm b/tests/print.scm
index d4b2cca93f..3386590d3a 100644
--- a/tests/print.scm
+++ b/tests/print.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2017, 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,7 +21,7 @@
   #:use-module (guix build-system gnu)
   #:use-module (guix download)
   #:use-module (guix packages)
-  #:use-module (guix licenses)
+  #:use-module ((guix licenses) #:prefix license:)
   #:use-module (srfi srfi-64))
 
 (define-syntax-rule (define-with-source object source expr)
@@ -42,11 +42,11 @@
               (sha256
                (base32
                 "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))))
-    (build-system gnu-build-system)
+    (build-system (@ (guix build-system gnu) gnu-build-system))
     (home-page "http://gnu.org")
     (synopsis "Dummy")
     (description "This is a dummy package.")
-    (license gpl3+)))
+    (license license:gpl3+)))
 
 (define-with-source pkg-with-inputs pkg-with-inputs-source
   (package
@@ -59,20 +59,20 @@
               (sha256
                (base32
                 "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))))
-    (build-system gnu-build-system)
+    (build-system (@ (guix build-system gnu) gnu-build-system))
     (inputs `(("coreutils" ,(@ (gnu packages base) coreutils))
               ("glibc" ,(@ (gnu packages base) glibc) "debug")))
     (home-page "http://gnu.org")
     (synopsis "Dummy")
     (description "This is a dummy package.")
-    (license gpl3+)))
+    (license license:gpl3+)))
 
 (test-equal "simple package"
-  pkg-source
+  `(define-public test ,pkg-source)
   (package->code pkg))
 
 (test-equal "package with inputs"
-  pkg-with-inputs-source
+  `(define-public test ,pkg-with-inputs-source)
   (package->code pkg-with-inputs))
 
 (test-end "print")
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 21c912a532..055924ba3e 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -223,6 +223,17 @@
                  (string=? (dirname (readlink bindir))
                            (derivation->output-path guile))))))
 
+(test-assertm "<profile>"
+  (mlet* %store-monad
+      ((entry ->   (package->manifest-entry %bootstrap-guile))
+       (profile -> (profile (hooks '()) (locales? #f)
+                            (content (manifest (list entry)))))
+       (drv        (lower-object profile))
+       (profile -> (derivation->output-path drv))
+       (bindir ->  (string-append profile "/bin"))
+       (_          (built-derivations (list drv))))
+    (return (file-exists? (string-append bindir "/guile")))))
+
 (test-assertm "profile-derivation relative symlinks, one entry"
   (mlet* %store-monad
       ((entry ->   (package->manifest-entry %bootstrap-guile))
diff --git a/tests/pypi.scm b/tests/pypi.scm
index 19af6e61fb..6788c8db3e 100644
--- a/tests/pypi.scm
+++ b/tests/pypi.scm
@@ -46,13 +46,13 @@
     \"1.0.0\": [
       {
         \"url\": \"https://example.com/foo-1.0.0.egg\",
-        \"packagetype\": \"bdist_egg\",
+        \"packagetype\": \"bdist_egg\"
       }, {
         \"url\": \"https://example.com/foo-1.0.0.tar.gz\",
-        \"packagetype\": \"sdist\",
+        \"packagetype\": \"sdist\"
       }, {
         \"url\": \"https://example.com/foo-1.0.0-py2.py3-none-any.whl\",
-        \"packagetype\": \"bdist_wheel\",
+        \"packagetype\": \"bdist_wheel\"
       }
     ]
   }
@@ -120,6 +120,7 @@ Provides-Extra: testing
 Requires-Dist: pytest (>=3.1.0); extra == 'testing'
 ")
 
+
 (test-begin "pypi")
 
 (test-equal "guix-package->pypi-name, old URL style"
diff --git a/tests/store.scm b/tests/store.scm
index b61a981b28..0e80ccc239 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -412,6 +412,69 @@
       (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"
+                           (search-bootstrap-binary "bash"
+                                                    (%current-system))))
+         (d1 (derivation %store "the-thing"
+                         s `("-e" ,b)
+                         #:env-vars `(("foo" . ,(random-text)))
+                         #:sources (list b s)))
+         (d2 (derivation %store "the-thing"
+                         s `("-e" ,b)
+                         #:env-vars `(("foo" . ,(random-text))
+                                      ("bar" . "baz"))
+                         #:sources (list b s))))
+    (with-build-handler (lambda (continue store things mode)
+                          (equal? (map derivation-file-name (list d1 d2))
+                                  things))
+      (map/accumulate-builds %store
+                             (lambda (drv)
+                               (build-derivations %store (list drv))
+                               (add-to-store %store "content-addressed"
+                                             #t "sha256"
+                                             (derivation->output-path drv)))
+                             (list d1 d2)))))
+
+(test-assert "mapm/accumulate-builds"
+  (let* ((d1 (run-with-store %store
+               (gexp->derivation "foo" #~(mkdir #$output))))
+         (d2 (run-with-store %store
+               (gexp->derivation "bar" #~(mkdir #$output)))))
+    (with-build-handler (lambda (continue store things mode)
+                          (equal? (map derivation-file-name (pk 'zz (list d1 d2)))
+                                  (pk 'XX things)))
+      (run-with-store %store
+        (mapm/accumulate-builds built-derivations `((,d1) (,d2)))))))
+
 (test-assert "topologically-sorted, one item"
   (let* ((a (add-text-to-store %store "a" "a"))
          (b (add-text-to-store %store "b" "b" (list a)))