Merge branch 'master' into core-updates

18 files changed, 659 insertions, 91 deletions

diff --git a/tests/challenge.scm b/tests/challenge.scm
index 4b13ec278e..c962800f3f 100644
--- a/tests/challenge.scm
+++ b/tests/challenge.scm
@@ -31,17 +31,9 @@
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match))
 
-(define %store
-  (open-connection-for-tests))
-
 (define query-path-hash*
   (store-lift query-path-hash))
 
-(define-syntax-rule (test-assertm name exp)
-  (test-assert name
-    (run-with-store %store exp
-                    #:guile-for-build (%guile-for-build))))
-
 (define* (call-with-derivation-narinfo* drv thunk hash)
   (lambda (store)
     (with-derivation-narinfo drv (sha256 => hash)
diff --git a/tests/channels.scm b/tests/channels.scm
new file mode 100644
index 0000000000..f3fc383ac3
--- /dev/null
+++ b/tests/channels.scm
@@ -0,0 +1,139 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-channels)
+  #:use-module (guix channels)
+  #:use-module ((guix build syscalls) #:select (mkdtemp!))
+  #:use-module (guix tests)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64)
+  #:use-module (ice-9 match))
+
+(test-begin "channels")
+
+(define* (make-instance #:key
+                        (name 'fake)
+                        (commit "cafebabe")
+                        (spec #f))
+  (define instance-dir (mkdtemp! "/tmp/checkout.XXXXXX"))
+  (and spec
+       (with-output-to-file (string-append instance-dir "/.guix-channel")
+         (lambda _ (format #t "~a" spec))))
+  ((@@ (guix channels) channel-instance)
+   name commit instance-dir))
+
+(define instance--boring (make-instance))
+(define instance--no-deps
+  (make-instance #:spec
+                 '(channel
+                   (version 0)
+                   (dependencies
+                    (channel
+                     (name test-channel)
+                     (url "https://example.com/test-channel"))))))
+(define instance--simple
+  (make-instance #:spec
+                 '(channel
+                   (version 0)
+                   (dependencies
+                    (channel
+                     (name test-channel)
+                     (url "https://example.com/test-channel"))))))
+(define instance--with-dupes
+  (make-instance #:spec
+                 '(channel
+                   (version 0)
+                   (dependencies
+                    (channel
+                     (name test-channel)
+                     (url "https://example.com/test-channel"))
+                    (channel
+                     (name test-channel)
+                     (url "https://example.com/test-channel")
+                     (commit "abc1234"))
+                    (channel
+                     (name test-channel)
+                     (url "https://example.com/test-channel-elsewhere"))))))
+
+(define read-channel-metadata
+  (@@ (guix channels) read-channel-metadata))
+
+
+(test-equal "read-channel-metadata returns #f if .guix-channel does not exist"
+  #f
+  (read-channel-metadata instance--boring))
+
+(test-assert "read-channel-metadata returns <channel-metadata>"
+  (every (@@ (guix channels) channel-metadata?)
+         (map read-channel-metadata
+              (list instance--no-deps
+                    instance--simple
+                    instance--with-dupes))))
+
+(test-assert "read-channel-metadata dependencies are channels"
+  (let ((deps ((@@ (guix channels) channel-metadata-dependencies)
+               (read-channel-metadata instance--simple))))
+    (match deps
+      (((? channel? dep)) #t)
+      (_ #f))))
+
+(test-assert "latest-channel-instances includes channel dependencies"
+  (let* ((channel (channel
+                   (name 'test)
+                   (url "test")))
+         (test-dir (channel-instance-checkout instance--simple)))
+    (mock ((guix git) latest-repository-commit
+           (lambda* (store url #:key ref)
+             (match url
+               ("test" (values test-dir 'whatever))
+               (_ (values "/not-important" 'not-important)))))
+          (let ((instances (latest-channel-instances #f (list channel))))
+            (and (eq? 2 (length instances))
+                 (lset= eq?
+                        '(test test-channel)
+                        (map (compose channel-name channel-instance-channel)
+                             instances)))))))
+
+(test-assert "latest-channel-instances excludes duplicate channel dependencies"
+  (let* ((channel (channel
+                   (name 'test)
+                   (url "test")))
+         (test-dir (channel-instance-checkout instance--with-dupes)))
+    (mock ((guix git) latest-repository-commit
+           (lambda* (store url #:key ref)
+             (match url
+               ("test" (values test-dir 'whatever))
+               (_ (values "/not-important" 'not-important)))))
+          (let ((instances (latest-channel-instances #f (list channel))))
+            (and (eq? 2 (length instances))
+                 (lset= eq?
+                        '(test test-channel)
+                        (map (compose channel-name channel-instance-channel)
+                             instances))
+                 ;; only the most specific channel dependency should remain,
+                 ;; i.e. the one with a specified commit.
+                 (find (lambda (instance)
+                         (and (eq? (channel-name
+                                    (channel-instance-channel instance))
+                                   'test-channel)
+                              (eq? (channel-commit
+                                    (channel-instance-channel instance))
+                                   'abc1234)))
+                       instances))))))
+
+(test-end "channels")
diff --git a/tests/debug-link.scm b/tests/debug-link.scm
index 2dde3cb460..a1ae4f141c 100644
--- a/tests/debug-link.scm
+++ b/tests/debug-link.scm
@@ -43,14 +43,6 @@
 (define read-elf
   (compose parse-elf get-bytevector-all))
 
-(define %store
-  (open-connection-for-tests))
-
-(define-syntax-rule (test-assertm name exp)
-  (test-assert name
-    (run-with-store %store exp
-                    #:guile-for-build (%guile-for-build))))
-
 
 (test-begin "debug-link")
 
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 159a6971b3..5f294c1827 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -1132,6 +1132,16 @@
                                     ((p2 . _)
                                      (string<? p1 p2)))))))))))))
 
+(test-equal "derivation-properties"
+  (list '() '((type . test)))
+  (let ((drv1 (build-expression->derivation %store "bar"
+                                            '(mkdir %output)))
+        (drv2 (build-expression->derivation %store "foo"
+                                           '(mkdir %output)
+                                           #:properties '((type . test)))))
+    (list (derivation-properties drv1)
+          (derivation-properties drv2))))
+
 (test-equal "map-derivation"
   "hello"
   (let* ((joke (package-derivation %store guile-1.8))
diff --git a/tests/gexp.scm b/tests/gexp.scm
index bc83a8de8c..35a76a496e 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -62,11 +62,6 @@
                                      #:target target)
                   #:guile-for-build (%guile-for-build)))
 
-(define-syntax-rule (test-assertm name exp)
-  (test-assert name
-    (run-with-store %store exp
-                    #:guile-for-build (%guile-for-build))))
-
 (define %extension-package
   ;; Example of a package to use when testing 'with-extensions'.
   (dummy-package "extension"
@@ -481,7 +476,15 @@
     (return (and (string=? (readlink (string-append out "/foo")) guile)
                  (string=? (readlink out2) file)
                  (equal? refs (list (dirname (dirname guile))))
-                 (equal? refs2 (list file))))))
+                 (equal? refs2 (list file))
+                 (null? (derivation-properties drv))))))
+
+(test-assertm "gexp->derivation properties"
+  (mlet %store-monad ((drv (gexp->derivation "foo"
+                                             #~(mkdir #$output)
+                                             #:properties '((type . test)))))
+    (return (equal? '((type . test))
+                    (derivation-properties drv)))))
 
 (test-assertm "gexp->derivation vs. grafts"
   (mlet* %store-monad ((graft?  (set-grafting #f))
@@ -680,6 +683,22 @@
    #~(foo #$@(list (with-imported-modules '((foo)) #~+)
                    (with-imported-modules '((bar)) #~-)))))
 
+(test-assert "gexp-modules deletes duplicates"   ;<https://bugs.gnu.org/32966>
+  (let ((make-file (lambda ()
+                     ;; Use 'eval' to make sure we get an object that's not
+                     ;; 'eq?' nor 'equal?' due to the closures it embeds.
+                     (eval '(scheme-file "bar.scm" #~(define-module (bar)))
+                           (current-module)))))
+    (define result
+      ((@@ (guix gexp) gexp-modules)
+       (with-imported-modules `(((bar) => ,(make-file))
+                                ((bar) => ,(make-file))
+                                (foo) (foo))
+         #~+)))
+
+    (match result
+      (((('bar) '=> (? scheme-file?)) ('foo)) #t))))
+
 (test-equal "gexp-modules and literal Scheme object"
   '()
   (gexp-modules #t))
diff --git a/tests/grafts.scm b/tests/grafts.scm
index abb074d628..f85f3c6913 100644
--- a/tests/grafts.scm
+++ b/tests/grafts.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -51,7 +51,8 @@
 
 (test-begin "grafts")
 
-(test-assert "graft-derivation, grafted item is a direct dependency"
+(test-equal "graft-derivation, grafted item is a direct dependency"
+  '((type . graft) (graft (count . 2)))
   (let* ((build `(begin
                    (mkdir %output)
                    (chdir %output)
@@ -76,14 +77,16 @@
                                             (origin %mkdir)
                                             (replacement two))))))
     (and (build-derivations %store (list grafted))
-         (let ((two     (derivation->output-path two))
-               (grafted (derivation->output-path grafted)))
+         (let ((properties (derivation-properties grafted))
+               (two        (derivation->output-path two))
+               (grafted    (derivation->output-path grafted)))
            (and (string=? (format #f "foo/~a/bar" two)
                           (call-with-input-file (string-append grafted "/text")
                             get-string-all))
                 (string=? (readlink (string-append grafted "/sh")) one)
                 (string=? (readlink (string-append grafted "/self"))
-                          grafted))))))
+                          grafted)
+                properties)))))
 
 (test-assert "graft-derivation, grafted item uses a different name"
   (let* ((build   `(begin
diff --git a/tests/guix-build-branch.sh b/tests/guix-build-branch.sh
new file mode 100644
index 0000000000..e64782c831
--- /dev/null
+++ b/tests/guix-build-branch.sh
@@ -0,0 +1,56 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+#
+# This file is part of GNU Guix.
+#
+# GNU Guix is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# GNU Guix is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+#
+# Test 'guix build --with-branch'.
+#
+
+guix build --version
+
+# 'guix build --with-branch' requires access to the network to clone the
+# Git repository below.
+
+if ! guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
+then
+    # Skipping.
+    exit 77
+fi
+
+orig_drv="`guix build guile-gcrypt -d`"
+latest_drv="`guix build guile-gcrypt --with-branch=guile-gcrypt=master -d`"
+test -n "$latest_drv"
+test "$orig_drv" != "$latest_drv"
+
+# FIXME: '-S' currently doesn't work with non-derivation source.
+# checkout="`guix build guile-gcrypt --with-branch=guile-gcrypt=master -S`"
+checkout="`guix gc --references "$latest_drv" | grep guile-gcrypt | grep -v -E '(-builder|\.drv)'`"
+test -d "$checkout"
+test -f "$checkout/COPYING"
+
+orig_drv="`guix build guix -d`"
+latest_drv="`guix build guix --with-branch=guile-gcrypt=master -d`"
+guix gc -R "$latest_drv" | grep guile-gcrypt-git.master
+test "$orig_drv" != "$latest_drv"
+
+v0_1_0_drv="`guix build guix --with-commit=guile-gcrypt=9e3eacdec1d -d`"
+guix gc -R "$v0_1_0_drv" | grep guile-gcrypt-git.9e3eacd
+test "$v0_1_0_drv" != "$latest_drv"
+test "$v0_1_0_drv" != "$orig_drv"
+
+if guix build guix --with-commit=guile-gcrypt=000 -d
+then false; else true; fi
diff --git a/tests/guix-pack-localstatedir.sh b/tests/guix-pack-localstatedir.sh
new file mode 100644
index 0000000000..b734b0f7e3
--- /dev/null
+++ b/tests/guix-pack-localstatedir.sh
@@ -0,0 +1,69 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+#
+# This file is part of GNU Guix.
+#
+# GNU Guix is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# GNU Guix is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+#
+# Test the 'guix pack --localstatedir' command-line utility.
+#
+
+guix pack --version
+
+# 'guix pack --localstatedir' produces derivations that depend on
+# guile-sqlite3 and guile-gcrypt.  To make that relatively inexpensive, run
+# the test in the user's global store if possible, on the grounds that
+# binaries may already be there or can be built or downloaded inexpensively.
+
+NIX_STORE_DIR="`guile -c '(use-modules (guix config))(display %storedir)'`"
+localstatedir="`guile -c '(use-modules (guix config))(display %localstatedir)'`"
+GUIX_DAEMON_SOCKET="$localstatedir/guix/daemon-socket/socket"
+export NIX_STORE_DIR GUIX_DAEMON_SOCKET
+
+if ! guile -c '(use-modules (guix)) (exit (false-if-exception (open-connection)))'
+then
+    exit 77
+fi
+
+# Build a tarball with '--localstatedir'
+the_pack="`guix pack -C none --localstatedir --profile-name=current-guix \
+            guile-bootstrap`"
+test_directory="`mktemp -d`"
+trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
+
+cd "$test_directory"
+tar -xf "$the_pack"
+
+profile="`find -name current-guix`"
+test "`readlink $profile`" = "current-guix-1-link"
+test -s "`dirname $profile`/../../../db/db.sqlite"
+test -x ".`guix build guile-bootstrap`/bin/guile"
+cd -
+
+# Make sure the store database is not completely bogus.
+guile -c "(use-modules (sqlite3) (guix config) (ice-9 match))
+
+  (define db
+    (sqlite-open (string-append \"$test_directory\"
+                                %localstatedir
+                               \"/guix/db/db.sqlite\")
+                 SQLITE_OPEN_READONLY))
+
+  (define stmt
+    (sqlite-prepare db \"SELECT * FROM ValidPaths;\"))
+
+  (match (sqlite-fold cons '() stmt)
+    ((#(ids paths hashes times derivers sizes) ...)
+     (exit (member \"`guix build guile-bootstrap`\" paths))))"
diff --git a/tests/guix-pack-relocatable.sh b/tests/guix-pack-relocatable.sh
new file mode 100644
index 0000000000..554416627b
--- /dev/null
+++ b/tests/guix-pack-relocatable.sh
@@ -0,0 +1,61 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+#
+# This file is part of GNU Guix.
+#
+# GNU Guix is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# GNU Guix is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+#
+# Test the 'guix pack --relocatable' using the external store, if any.
+#
+
+guix pack --version
+
+# 'guix pack --relocatable' requires a C compiler and libc.a, which our
+# bootstrap binaries don't provide.  To make the test relatively inexpensive,
+# run it on the user's global store if possible, on the grounds that binaries
+# may already be there or can be built or downloaded inexpensively.
+
+NIX_STORE_DIR="`guile -c '(use-modules (guix config))(display %storedir)'`"
+localstatedir="`guile -c '(use-modules (guix config))(display %localstatedir)'`"
+GUIX_DAEMON_SOCKET="$localstatedir/guix/daemon-socket/socket"
+export NIX_STORE_DIR GUIX_DAEMON_SOCKET
+
+if ! guile -c '(use-modules (guix)) (exit (false-if-exception (open-connection)))'
+then
+    exit 77
+fi
+
+STORE_PARENT="`dirname $NIX_STORE_DIR`"
+export STORE_PARENT
+if test "$STORE_PARENT" = "/"; then exit 77; fi
+
+# This test requires user namespaces and associated command-line tools.
+if ! unshare -mrf sh -c 'mount -t tmpfs none "$STORE_PARENT"'
+then
+    exit 77
+fi
+
+test_directory="`mktemp -d`"
+export test_directory
+trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
+
+tarball="`guix pack -R -S /Bin=bin sed`"
+(cd "$test_directory"; tar xvf "$tarball")
+
+# Run that relocatable 'sed' in a user namespace where we "erase" the store by
+# 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"'
+grep 'GNU sed' "$test_directory/output"
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index cd721a60e9..a43f4d128f 100644
--- a/tests/guix-pack.sh
+++ b/tests/guix-pack.sh
@@ -29,39 +29,27 @@ fi
 
 guix pack --version
 
-# Starting from commit 66e9944e078cbb9e0d618377dd6df6e639640efa, 'guix pack'
-# produces derivations that refer to guile-sqlite3 and libgcrypt.  To make
-# that relatively inexpensive, run the test in the user's global store if
-# possible, on the grounds that binaries may already be there or can be built
-# or downloaded inexpensively.
-
-NIX_STORE_DIR="`guile -c '(use-modules (guix config))(display %storedir)'`"
-localstatedir="`guile -c '(use-modules (guix config))(display %localstatedir)'`"
-GUIX_DAEMON_SOCKET="$localstatedir/guix/daemon-socket/socket"
-export NIX_STORE_DIR GUIX_DAEMON_SOCKET
-
-if ! guile -c '(use-modules (guix)) (exit (false-if-exception (open-connection)))'
-then
-    exit 77
-fi
+# Use --no-substitutes because we need to verify we can do this ourselves.
+GUIX_BUILD_OPTIONS="--no-substitutes"
+export GUIX_BUILD_OPTIONS
 
 # Build a tarball with no compression.
-guix pack --compression=none guile-bootstrap
+guix pack --compression=none --bootstrap guile-bootstrap
 
 # Build a tarball (with compression).  Check that '-e' works as well.
-out1="`guix pack guile-bootstrap`"
-out2="`guix pack -e '(@ (gnu packages bootstrap) %bootstrap-guile)'`"
+out1="`guix pack --bootstrap guile-bootstrap`"
+out2="`guix pack --bootstrap -e '(@ (gnu packages bootstrap) %bootstrap-guile)'`"
 test -n "$out1"
 test "$out1" = "$out2"
 
 # Build a tarball with a symlink.
-the_pack="`guix pack -S /opt/gnu/bin=bin guile-bootstrap`"
+the_pack="`guix pack --bootstrap -S /opt/gnu/bin=bin guile-bootstrap`"
 
 # Try to extract it.  Note: we cannot test whether /opt/gnu/bin/guile itself
 # exists because /opt/gnu/bin may be an absolute symlink to a store item that
 # has been GC'd.
 test_directory="`mktemp -d`"
-trap 'rm -rf "$test_directory"' EXIT
+trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
 cd "$test_directory"
 tar -xf "$the_pack"
 test -L opt/gnu/bin
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index f7dfbfad00..7eeb4304d1 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -106,6 +106,10 @@ guix package --show=guile | grep "^name: guile"
 # Ensure `--show' doesn't fail for packages with non-package inputs.
 guix package --show=texlive
 
+# Fail for non-existent packages or package/version pairs.
+if guix package --show=does-not-exist; then false; else true; fi
+if guix package --show=emacs@42; then false; else true; fi
+
 # Search.
 LC_MESSAGES=C
 export LC_MESSAGES
diff --git a/tests/inferior.scm b/tests/inferior.scm
index d1d5c00a77..d5a894ca8f 100644
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -157,6 +157,15 @@
     (close-inferior inferior)
     result))
 
+(test-equal "inferior-eval-with-store"
+  (add-text-to-store %store "foo" "Hello, world!")
+  (let* ((inferior (open-inferior %top-builddir
+                                  #:command "scripts/guix")))
+    (inferior-eval-with-store inferior %store
+                              '(lambda (store)
+                                 (add-text-to-store store "foo"
+                                                    "Hello, world!")))))
+
 (test-equal "inferior-package-derivation"
   (map derivation-file-name
        (list (package-derivation %store %bootstrap-guile "x86_64-linux")
diff --git a/tests/lint.scm b/tests/lint.scm
index ab0e8b9a8c..300153e24e 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
 ;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org>
-;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
@@ -365,7 +365,7 @@
                    (arguments
                     '(#:imported-modules (invalid-module))))))
         (check-derivation pkg)))
-    "failed to create derivation")))
+    "failed to create")))
 
 (test-assert "license: invalid license"
   (string-contains
diff --git a/tests/nar.scm b/tests/nar.scm
index d610ea53f7..5ffe68c9e2 100644
--- a/tests/nar.scm
+++ b/tests/nar.scm
@@ -25,6 +25,8 @@
                 #:select (open-sha256-port open-sha256-input-port))
   #:use-module ((guix packages)
                 #:select (base32))
+  #:use-module ((guix build utils)
+                #:select (find-files))
   #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
@@ -332,13 +334,6 @@
       (lambda ()
         (rmdir input)))))
 
-;; 'restore-file-set' depends on 'open-sha256-input-port', which in turn
-;; relies on a Guile 2.0.10+ feature.
-(test-skip (if (false-if-exception
-                (open-sha256-input-port (%make-void-port "r")))
-               0
-               3))
-
 (test-assert "restore-file-set (signed, valid)"
   (with-store store
     (let* ((texts (unfold (cut >= <> 10)
@@ -361,7 +356,43 @@
                           (map (lambda (file)
                                  (call-with-input-file file
                                    get-string-all))
-                               files))))))))
+                               files))
+                  (every canonical-file? files)))))))
+
+(test-assert "restore-file-set with directories (signed, valid)"
+  ;; <https://bugs.gnu.org/33361> describes a bug whereby directories
+  ;; containing files subject to deduplication were not canonicalized--i.e.,
+  ;; their mtime and permissions were not reset.  Ensure that this bug is
+  ;; gone.
+  (with-store store
+    (let* ((text1 (random-text))
+           (text2 (random-text))
+           (tree  `("tree" directory
+                    ("a" regular (data ,text1))
+                    ("b" directory
+                     ("c" regular (data ,text2))
+                     ("d" regular (data ,text1))))) ;duplicate
+           (file  (add-file-tree-to-store store tree))
+           (dump  (call-with-bytevector-output-port
+                   (cute export-paths store (list file) <>))))
+      (delete-paths store (list file))
+      (and (not (file-exists? file))
+           (let* ((source   (open-bytevector-input-port dump))
+                  (imported (restore-file-set source)))
+             (and (equal? imported (list file))
+                  (file-exists? file)
+                  (valid-path? store file)
+                  (string=? text1
+                            (call-with-input-file (string-append file "/a")
+                              get-string-all))
+                  (string=? text2
+                            (call-with-input-file
+                                (string-append file "/b/c")
+                              get-string-all))
+                  (= (stat:ino (stat (string-append file "/a"))) ;deduplication
+                     (stat:ino (stat (string-append file "/b/d"))))
+                  (every canonical-file?
+                         (find-files file #:directories? #t))))))))
 
 (test-assert "restore-file-set (missing signature)"
   (let/ec return
diff --git a/tests/pack.scm b/tests/pack.scm
index 7f867894c2..40473a9fe9 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -22,20 +22,26 @@
   #:use-module (guix store)
   #:use-module (guix derivations)
   #:use-module (guix profiles)
+  #:use-module (guix packages)
   #:use-module (guix monads)
   #:use-module (guix grafts)
   #:use-module (guix tests)
   #:use-module (guix gexp)
   #:use-module (gnu packages bootstrap)
+  #:use-module ((gnu packages compression) #:select (squashfs-tools-next))
   #:use-module (srfi srfi-64))
 
+(define %store
+  (open-connection-for-tests))
+
 ;; Globally disable grafts because they can trigger early builds.
 (%graft? #f)
 
 (define-syntax-rule (test-assertm name store exp)
   (test-assert name
-    (run-with-store store exp
-                    #:guile-for-build (%guile-for-build))))
+    (let ((guile (package-derivation store %bootstrap-guile)))
+      (run-with-store store exp
+                      #:guile-for-build guile))))
 
 (define %gzip-compressor
   ;; Compressor that uses the bootstrap 'gzip'.
@@ -48,6 +54,58 @@
 
 (test-begin "pack")
 
+(unless (network-reachable?) (test-skip 1))
+(test-assertm "self-contained-tarball" %store
+  (mlet* %store-monad
+      ((profile (profile-derivation (packages->manifest
+                                     (list %bootstrap-guile))
+                                    #:hooks '()
+                                    #:locales? #f))
+       (tarball (self-contained-tarball "pack" profile
+                                        #:symlinks '(("/bin/Guile"
+                                                      -> "bin/guile"))
+                                        #:compressor %gzip-compressor
+                                        #:archiver %tar-bootstrap))
+       (check   (gexp->derivation
+                 "check-tarball"
+                 (with-imported-modules '((guix build utils))
+                   #~(begin
+                       (use-modules (guix build utils)
+                                    (srfi srfi-1))
+
+                       (define store
+                         ;; The unpacked store.
+                         (string-append "." (%store-directory) "/"))
+
+                       (define (canonical? file)
+                         ;; Return #t if FILE is read-only and its mtime is 1.
+                         (let ((st (lstat file)))
+                           (or (not (string-prefix? store file))
+                               (eq? 'symlink (stat:type st))
+                               (and (= 1 (stat:mtime st))
+                                    (zero? (logand #o222
+                                                   (stat:mode st)))))))
+
+                       (define bin
+                         (string-append "." #$profile "/bin"))
+
+                       (setenv "PATH"
+                               (string-append #$%tar-bootstrap "/bin"))
+                       (system* "tar" "xvf" #$tarball)
+                       (mkdir #$output)
+                       (exit
+                        (and (file-exists? (string-append bin "/guile"))
+                             (file-exists? store)
+                             (every canonical?
+                                    (find-files "." (const #t)
+                                                #:directories? #t))
+                             (string=? (string-append #$%bootstrap-guile "/bin")
+                                       (readlink bin))
+                             (string=? (string-append ".." #$profile
+                                                      "/bin/guile")
+                                       (readlink "bin/Guile")))))))))
+    (built-derivations (list check))))
+
 ;; The following test needs guile-sqlite3, libgcrypt, etc. as a consequence of
 ;; commit c45477d2a1a651485feede20fe0f3d15aec48b39 and related changes.  Thus,
 ;; run it on the user's store, if it's available, on the grounds that these
@@ -55,18 +113,16 @@
 ;; quite inexpensively; see <https://bugs.gnu.org/32184>.
 
 (with-external-store store
-  (unless store (tests-skip 1))
-  (test-assertm "self-contained-tarball" store
+  (unless store (test-skip 1))
+  (test-assertm "self-contained-tarball + localstatedir" store
     (mlet* %store-monad
-        ((profile (profile-derivation (packages->manifest
+        ((guile   (set-guile-for-build (default-guile)))
+         (profile (profile-derivation (packages->manifest
                                        (list %bootstrap-guile))
                                       #:hooks '()
                                       #:locales? #f))
-         (tarball (self-contained-tarball "pack" profile
-                                          #:symlinks '(("/bin/Guile"
-                                                        -> "bin/guile"))
-                                          #:compressor %gzip-compressor
-                                          #:archiver %tar-bootstrap))
+         (tarball (self-contained-tarball "tar-pack" profile
+                                          #:localstatedir? #t))
          (check   (gexp->derivation
                    "check-tarball"
                    #~(let ((bin (string-append "." #$profile "/bin")))
@@ -75,12 +131,84 @@
                        (system* "tar" "xvf" #$tarball)
                        (mkdir #$output)
                        (exit
-                        (and (file-exists? (string-append bin "/guile"))
+                        (and (file-exists? "var/guix/db/db.sqlite")
                              (string=? (string-append #$%bootstrap-guile "/bin")
-                                       (readlink bin))
-                             (string=? (string-append ".." #$profile
-                                                      "/bin/guile")
-                                       (readlink "bin/Guile"))))))))
+                                       (readlink bin))))))))
+      (built-derivations (list check))))
+
+  (unless store (test-skip 1))
+  (test-assertm "docker-image + localstatedir" store
+    (mlet* %store-monad
+        ((guile   (set-guile-for-build (default-guile)))
+         (profile (profile-derivation (packages->manifest
+                                       (list %bootstrap-guile))
+                                      #:hooks '()
+                                      #:locales? #f))
+         (tarball (docker-image "docker-pack" profile
+                                #:symlinks '(("/bin/Guile" -> "bin/guile"))
+                                #:localstatedir? #t))
+         (check   (gexp->derivation
+                   "check-tarball"
+                   (with-imported-modules '((guix build utils))
+                     #~(begin
+                         (use-modules (guix build utils)
+                                      (ice-9 match))
+
+                         (define bin
+                           (string-append "." #$profile "/bin"))
+
+                         (setenv "PATH" (string-append #$%tar-bootstrap "/bin"))
+                         (mkdir "base")
+                         (with-directory-excursion "base"
+                           (invoke "tar" "xvf" #$tarball))
+
+                         (match (find-files "base" "layer.tar")
+                           ((layer)
+                            (invoke "tar" "xvf" layer)))
+
+                         (when
+                          (and (file-exists? (string-append bin "/guile"))
+                               (file-exists? "var/guix/db/db.sqlite")
+                               (string=? (string-append #$%bootstrap-guile "/bin")
+                                         (pk 'binlink (readlink bin)))
+                               (string=? (string-append #$profile "/bin/guile")
+                                         (pk 'guilelink (readlink "bin/Guile"))))
+                          (mkdir #$output)))))))
+      (built-derivations (list check))))
+
+  (unless store (test-skip 1))
+  (test-assertm "squashfs-image + localstatedir" store
+    (mlet* %store-monad
+        ((guile   (set-guile-for-build (default-guile)))
+         (profile (profile-derivation (packages->manifest
+                                       (list %bootstrap-guile))
+                                      #:hooks '()
+                                      #:locales? #f))
+         (image   (squashfs-image "squashfs-pack" profile
+                                  #:symlinks '(("/bin" -> "bin"))
+                                  #:localstatedir? #t))
+         (check   (gexp->derivation
+                   "check-tarball"
+                   (with-imported-modules '((guix build utils))
+                     #~(begin
+                         (use-modules (guix build utils)
+                                      (ice-9 match))
+
+                         (define bin
+                           (string-append "." #$profile "/bin"))
+
+                         (setenv "PATH"
+                                 (string-append #$squashfs-tools-next "/bin"))
+                         (invoke "unsquashfs" #$image)
+                         (with-directory-excursion "squashfs-root"
+                           (when (and (file-exists? (string-append bin
+                                                                   "/guile"))
+                                      (file-exists? "var/guix/db/db.sqlite")
+                                      (string=? (string-append #$%bootstrap-guile "/bin")
+                                                (pk 'binlink (readlink bin)))
+                                      (string=? (string-append #$profile "/bin")
+                                                (pk 'guilelink (readlink "bin"))))
+                             (mkdir #$output))))))))
       (built-derivations (list check)))))
 
 (test-end)
diff --git a/tests/processes.scm b/tests/processes.scm
new file mode 100644
index 0000000000..40454bcbc7
--- /dev/null
+++ b/tests/processes.scm
@@ -0,0 +1,86 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-processes)
+  #:use-module (guix scripts processes)
+  #:use-module (guix store)
+  #:use-module (guix derivations)
+  #:use-module (guix packages)
+  #:use-module (guix gexp)
+  #:use-module ((guix utils) #:select (call-with-temporary-directory))
+  #:use-module (gnu packages bootstrap)
+  #:use-module (guix tests)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64)
+  #:use-module (rnrs bytevectors)
+  #:use-module (rnrs io ports)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 threads))
+
+(test-begin "processes")
+
+(test-assert "not a client"
+  (not (find (lambda (session)
+               (= (getpid)
+                  (process-id (daemon-session-client session))))
+             (daemon-sessions))))
+
+(test-assert "client"
+  (with-store store
+    (let* ((session (find (lambda (session)
+                            (= (getpid)
+                               (process-id (daemon-session-client session))))
+                          (daemon-sessions)))
+           (daemon  (daemon-session-process session)))
+      (and (kill (process-id daemon) 0)
+           (string-suffix? "guix-daemon" (first (process-command daemon)))))))
+
+(test-assert "client + lock"
+  (with-store store
+    (call-with-temporary-directory
+     (lambda (directory)
+       (let* ((token1  (string-append directory "/token1"))
+              (token2  (string-append directory "/token2"))
+              (exp     #~(begin #$(random-text)
+                                (mkdir #$token1)
+                                (let loop ()
+                                  (unless (file-exists? #$token2)
+                                    (sleep 1)
+                                    (loop)))
+                                (mkdir #$output)))
+              (guile   (package-derivation store %bootstrap-guile))
+              (drv     (run-with-store store
+                         (gexp->derivation "foo" exp
+                                           #:guile-for-build guile)))
+              (thread  (call-with-new-thread
+                        (lambda ()
+                          (build-derivations store (list drv)))))
+              (_       (let loop ()
+                         (unless (file-exists? token1)
+                           (usleep 200)
+                           (loop))))
+              (session (find (lambda (session)
+                               (= (getpid)
+                                  (process-id (daemon-session-client session))))
+                             (daemon-sessions)))
+              (locks   (daemon-session-locks-held (pk 'session session))))
+         (call-with-output-file token2 (const #t))
+         (equal? (list (string-append (derivation->output-path drv) ".lock"))
+                 locks))))))
+
+(test-end "processes")
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 9f366a04ef..1f9bbd099d 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -47,17 +47,6 @@
 ;; Globally disable grafts because they can trigger early builds.
 (%graft? #f)
 
-(define-syntax-rule (test-assertm name exp)
-  (test-assert name
-    (run-with-store %store exp
-                    #:guile-for-build (%guile-for-build))))
-
-(define-syntax-rule (test-equalm name value exp)
-  (test-equal name
-    value
-    (run-with-store %store exp
-                    #:guile-for-build (%guile-for-build))))
-
 ;; Example manifest entries.
 
 (define guile-1.8.8
diff --git a/tests/size.scm b/tests/size.scm
index 575b1abfdd..0aaa8fbc29 100644
--- a/tests/size.scm
+++ b/tests/size.scm
@@ -30,14 +30,6 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-64))
 
-(define %store
-  (open-connection-for-tests))
-
-(define-syntax-rule (test-assertm name exp)
-  (test-assert name
-    (run-with-store %store exp
-                    #:guile-for-build (%guile-for-build))))
-
 
 (test-begin "size")