Merge remote-tracking branch 'origin/master' into core-updates

12 files changed, 533 insertions, 142 deletions

diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index d7e579bc89..a00b227551 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -46,6 +46,9 @@
 (define %default-initrd (string-append %default-initrd-path "/initrd.cpio.gz"))
 (define %default-root-device (uuid "abcdef12-3456-7890-abcd-ef1234567890"))
 (define %default-store-device (uuid "01234567-89ab-cdef-0123-456789abcdef"))
+(define %default-btrfs-subvolume "testfs")
+(define %default-store-directory-prefix
+  (string-append "/" %default-btrfs-subvolume))
 (define %default-store-mount-point (%store-prefix))
 (define %default-multiboot-modules '())
 (define %default-locale "es_ES.utf8")
@@ -63,6 +66,7 @@
    (multiboot-modules %default-multiboot-modules)
    (locale %default-locale)
    (store-device %default-store-device)
+   (store-directory-prefix %default-store-directory-prefix)
    (store-mount-point %default-store-mount-point)))
 
 (define %default-operating-system
@@ -81,7 +85,10 @@
 		         (file-system
                            (device %default-store-device)
                            (mount-point %default-store-mount-point)
-                           (type "btrfs"))
+                           (type "btrfs")
+                           (options
+                            (string-append "subvol="
+                                           %default-btrfs-subvolume)))
                          %base-file-systems))))
 
 (define (quote-uuid uuid)
@@ -103,6 +110,7 @@
           (with-store #t)
           (store-device
            (quote-uuid %default-store-device))
+          (store-directory-prefix %default-store-directory-prefix)
           (store-mount-point %default-store-mount-point))
   (define (generate-boot-parameters)
     (define (sexp-or-nothing fmt val)
@@ -117,10 +125,12 @@
             (sexp-or-nothing " (kernel-arguments ~S)" kernel-arguments)
             (sexp-or-nothing " (initrd ~S)" initrd)
             (if with-store
-                (format #false " (store~a~a)"
+                (format #false " (store~a~a~a)"
                         (sexp-or-nothing " (device ~S)" store-device)
                         (sexp-or-nothing " (mount-point ~S)"
-                                         store-mount-point))
+                                         store-mount-point)
+                        (sexp-or-nothing " (directory-prefix ~S)"
+                                         store-directory-prefix))
                 "")
             (sexp-or-nothing " (locale ~S)" locale)
             (sexp-or-nothing " (bootloader-name ~a)" bootloader-name)
@@ -149,6 +159,7 @@
        (test-read-boot-parameters #:store-device #false)
        (test-read-boot-parameters #:store-device 'false)
        (test-read-boot-parameters #:store-mount-point #false)
+       (test-read-boot-parameters #:store-directory-prefix #false)
        (test-read-boot-parameters #:multiboot-modules #false)
        (test-read-boot-parameters #:locale #false)
        (test-read-boot-parameters #:bootloader-name #false
@@ -253,4 +264,10 @@
    (operating-system-boot-parameters %default-operating-system
                                      %default-root-device)))
 
+(test-equal "from os, store-directory-prefix"
+  %default-store-directory-prefix
+  (boot-parameters-store-directory-prefix
+   (operating-system-boot-parameters %default-operating-system
+                                     %default-root-device)))
+
 (test-end "boot-parameters")
diff --git a/tests/build-utils.scm b/tests/build-utils.scm
index 47a57a984b..654b480ed9 100644
--- a/tests/build-utils.scm
+++ b/tests/build-utils.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2015, 2016, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2015, 2016, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -174,7 +174,7 @@ echo hello world"))
        (let ((script-file-name (string-append directory "/foo")))
          (call-with-output-file script-file-name
            (lambda (port)
-             (format port script-contents)))
+             (display script-contents port)))
          (chmod script-file-name #o777)
          (wrap-script script-file-name
                       `("GUIX_FOO" prefix ("/some/path"
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 1beeb67c21..686334af61 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -30,6 +30,7 @@
   #:use-module (gnu packages)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bootstrap)
+  #:use-module ((guix diagnostics) #:select (guix-warning-port))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-64)
@@ -818,6 +819,17 @@
   '()
   (gexp-modules #t))
 
+(test-assert "gexp-modules, warning"
+  (string-match "tests/gexp.scm:[0-9]+:[0-9]+: warning: \
+importing.* \\(guix config\\) from the host"
+                (call-with-output-string
+                  (lambda (port)
+                    (parameterize ((guix-warning-port port))
+                      (let* ((x (with-imported-modules '((guix config))
+                                  #~(+ 1 2 3)))
+                             (y #~(+ 39 #$x)))
+                        (gexp-modules y)))))))
+
 (test-assertm "gexp->derivation #:modules"
   (mlet* %store-monad
       ((build ->  #~(begin
@@ -1413,7 +1425,7 @@
 
 (test-assert "printer"
   (string-match "^#<gexp \\(string-append .*#<package coreutils.*\
- \"/bin/uname\"\\) [[:xdigit:]]+>$"
+ \"/bin/uname\"\\) [[:graph:]]+tests/gexp\\.scm:[0-9]+:[0-9]+ [[:xdigit:]]+>$"
                 (with-output-to-string
                   (lambda ()
                     (write
diff --git a/tests/graph.scm b/tests/graph.scm
index 0663d13b49..e374dad1a5 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -198,7 +198,7 @@ edges."
 
 (test-assert "reverse bag DAG"
   (let-values (((dune bap ocaml-base)
-                (values (specification->package "dune")
+                (values (specification->package "ocaml4.07-dune")
                         (specification->package "bap")
                         (specification->package "ocaml4.07-base")))
                ((backend nodes+edges) (make-recording-backend)))
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index 4a58ea1476..b7602e668c 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -289,6 +289,12 @@ drv1=`guix build glib -d`
 drv2=`guix build glib -d --with-input=libreoffice=inkscape`
 test "$drv1" = "$drv2"
 
+# '--with-graft' should have no effect when using '--no-grafts'.
+# See <https://bugs.gnu.org/43890>.
+drv1=`guix build inkscape -d --no-grafts`
+drv2=`guix build inkscape -d --no-grafts --with-graft=glib=glib-networking`
+test "$drv1" = "$drv2"
+
 # Rewriting implicit inputs.
 drv1=`guix build hello -d`
 drv2=`guix build hello -d --with-input=gcc=gcc-toolchain`
diff --git a/tests/guix-pack-relocatable.sh b/tests/guix-pack-relocatable.sh
index a960ecd209..2beb1b1eb6 100644
--- a/tests/guix-pack-relocatable.sh
+++ b/tests/guix-pack-relocatable.sh
@@ -1,5 +1,6 @@
 # GNU Guix --- Functional package management for GNU
 # Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2020 Eric Bavier <bavier@posteo.net>
 #
 # This file is part of GNU Guix.
 #
@@ -58,6 +59,19 @@ run_without_store ()
     fi
 }
 
+# Wait for the given file to show up.  Error out if it doesn't show up in a
+# timely fashion.
+wait_for_file ()
+{
+    i=0
+    while ! test -f "$1" && test $i -lt 20
+    do
+	sleep 0.3
+	i=`expr $i + 1`
+    done
+    test -f "$1"
+}
+
 test_directory="`mktemp -d`"
 export test_directory
 trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
@@ -98,6 +112,7 @@ case "`uname -m`" in
 	run_without_store GUIX_EXECUTION_ENGINE="fakechroot" \
 	"$test_directory/Bin/sed" --version > "$test_directory/output"
 	grep 'GNU sed' "$test_directory/output"
+	unset GUIX_EXECUTION_ENGINE
 
 	chmod -Rf +w "$test_directory"; rm -rf "$test_directory"/*
 
@@ -129,12 +144,105 @@ case "`uname -m`" in
 	;;
 esac
 
+if unshare -r true
+then
+    # Check what happens if the wrapped binary forks and leaves child
+    # processes behind, like a daemon.  The root file system should remain
+    # available to those child processes.  See <https://bugs.gnu.org/44261>.
+    cat > "$test_directory/manifest.scm" <<EOF
+(use-modules (guix))
+
+(define daemon
+  (program-file "daemon"
+                #~(begin
+                    (use-modules (ice-9 match)
+                                 (ice-9 ftw))
+
+                    (call-with-output-file "parent-store"
+                      (lambda (port)
+                        (write (scandir (ungexp (%store-prefix)))
+                               port)))
+
+                    (match (primitive-fork)
+                      (0 (sigaction SIGHUP (const #t))
+                         (call-with-output-file "pid"
+                           (lambda (port)
+                             (display (getpid) port)))
+                         (pause)
+                         (call-with-output-file "child-store"
+                           (lambda (port)
+                             (write (scandir (ungexp (%store-prefix)))
+                                    port))))
+                      (_ #t)))))
+
+(define package
+  (computed-file "package"
+                 #~(let ((out (ungexp output)))
+                     (mkdir out)
+                     (mkdir (string-append out "/bin"))
+                     (symlink (ungexp daemon)
+                              (string-append out "/bin/daemon")))))
+
+(manifest (list (manifest-entry
+                  (name "daemon")
+                  (version "0")
+                  (item package))))
+EOF
+
+    tarball="$(guix pack -S /bin=bin -R -m "$test_directory/manifest.scm")"
+    (cd "$test_directory"; tar xf "$tarball")
+
+    # Run '/bin/daemon', which forks, then wait for the child, send it SIGHUP
+    # so that it dumps its view of the store, and make sure the child and
+    # parent both see the same store contents.
+    (cd "$test_directory"; run_without_store ./bin/daemon)
+    wait_for_file "$test_directory/pid"
+    kill -HUP $(cat "$test_directory/pid")
+    wait_for_file "$test_directory/child-store"
+    diff -u "$test_directory/parent-store" "$test_directory/child-store"
+
+    chmod -Rf +w "$test_directory"; rm -rf "$test_directory"/*
+fi
+
 # Ensure '-R' works with outputs other than "out".
 tarball="`guix pack -R -S /share=share groff:doc`"
 (cd "$test_directory"; tar xf "$tarball")
 test -d "$test_directory/share/doc/groff/html"
+chmod -Rf +w "$test_directory"; rm -rf "$test_directory"/*
 
 # Ensure '-R' applies to propagated inputs.  Failing to do that, it would fail
 # with a profile collision error in this case because 'python-scipy'
 # propagates 'python-numpy'.  See <https://bugs.gnu.org/42510>.
 guix pack -RR python-numpy python-scipy --no-grafts -n
+
+# Check that packages that mix executable and support files (e.g. git) in the
+# "binary" directories still work after wrapped.
+cat >"$test_directory/manifest.scm" <<'EOF'
+(use-modules (guix) (guix profiles) (guix search-paths)
+             (gnu packages bootstrap))
+(manifest
+ (list (manifest-entry
+        (name "test") (version "0")
+        (item (file-union "test"
+                          `(("bin/hello"
+                             ,(program-file
+                               "hello"
+                               #~(begin
+                                   (add-to-load-path (getenv "HELLO_EXEC_PATH"))
+                                   (display (load-from-path "msg"))(newline))
+                               #:guile %bootstrap-guile))
+                            ("libexec/hello/msg"
+                             ,(plain-file "msg" "42")))))
+        (search-paths
+         (list (search-path-specification
+                (variable "HELLO_EXEC_PATH")
+                (files '("libexec/hello"))
+                (separator #f)))))))
+EOF
+tarball="`guix pack -RR -S /opt= -m $test_directory/manifest.scm`"
+(cd "$test_directory"; tar xvf "$tarball")
+( export GUIX_PROFILE=$test_directory/opt
+  . $GUIX_PROFILE/etc/profile
+  run_without_store "$test_directory/opt/bin/hello" > "$test_directory/output" )
+cat "$test_directory/output"
+test "`cat $test_directory/output`" = "42"
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index 957479ede0..f14c92ca75 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -315,6 +315,9 @@ guix system build "$tmpdir/config.scm" -n 2>&1 | \
 guix system search tor | grep "^name: tor"
 guix system search tor | grep "^shepherdnames: tor"
 guix system search anonym network | grep "^name: tor"
+guix system search . > "$tmpdir/search"
+test $(wc -l < "$tmpdir/search") -gt 500
+rm "$tmpdir/search"
 
 # Below, use -n (--dry-run) for the tests because if we actually tried to
 # build these images, the commands would take hours to run in the worst case.
diff --git a/tests/lint.scm b/tests/lint.scm
index 95abd71378..9b230814a5 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -36,6 +37,10 @@
   #:use-module (guix lint)
   #:use-module (guix ui)
   #:use-module (guix swh)
+  #:use-module ((guix gexp) #:select (local-file))
+  #:use-module ((guix utils) #:select (call-with-temporary-directory))
+  #:use-module ((guix import hackage) #:select (%hackage-url))
+  #:use-module ((guix import stackage) #:select (%stackage-url))
   #:use-module (gnu packages)
   #:use-module (gnu packages glib)
   #:use-module (gnu packages pkg-config)
@@ -344,6 +349,60 @@
                   (list (search-patch "this-patch-does-not-exist!"))))))))
      (check-patch-file-names pkg))))
 
+(test-assert "patch headers: no warnings"
+  (call-with-temporary-directory
+   (lambda (directory)
+     (call-with-output-file (string-append directory "/t.patch")
+       (lambda (port)
+         (display "This is a patch.\n\n--- a\n+++ b\n"
+                  port)))
+
+     (parameterize ((%patch-path (list directory)))
+       (let ((pkg (dummy-package "x"
+                    (source (dummy-origin
+                             (patches (search-patches "t.patch")))))))
+         (null? (check-patch-headers pkg)))))))
+
+(test-equal "patch headers: missing comment"
+  "t.patch: patch lacks comment and upstream status"
+  (call-with-temporary-directory
+   (lambda (directory)
+     (call-with-output-file (string-append directory "/t.patch")
+       (lambda (port)
+         (display "\n--- a\n+++ b\n"
+                  port)))
+
+     (parameterize ((%patch-path (list directory)))
+       (let ((pkg (dummy-package "x"
+                    (source (dummy-origin
+                             (patches (search-patches "t.patch")))))))
+         (single-lint-warning-message (check-patch-headers pkg)))))))
+
+(test-equal "patch headers: empty"
+  "t.patch: empty patch"
+  (call-with-temporary-directory
+   (lambda (directory)
+     (call-with-output-file (string-append directory "/t.patch")
+       (const #t))
+
+     (parameterize ((%patch-path '()))
+       (let ((pkg (dummy-package "x"
+                    (source (dummy-origin
+                             (patches
+                              (list (local-file
+                                     (string-append directory
+                                                    "/t.patch")))))))))
+         (single-lint-warning-message (check-patch-headers pkg)))))))
+
+(test-equal "patch headers: patch not found"
+  "does-not-exist.patch: patch not found\n"
+  (parameterize ((%patch-path '()))
+    (let ((pkg (dummy-package "x"
+                 (source (dummy-origin
+                          (patches
+                           (search-patches "does-not-exist.patch")))))))
+      (single-lint-warning-message (check-patch-headers pkg)))))
+
 (test-equal "derivation: invalid arguments"
   "failed to create x86_64-linux derivation: (wrong-type-arg \"map\" \"Wrong type argument: ~S\" (invalid-module) ())"
   (match (let ((pkg (dummy-package "x"
@@ -1001,6 +1060,35 @@
     (string-contains (single-lint-warning-message warnings)
                      "rate limit reached")))
 
+(test-skip (if (http-server-can-listen?) 0 1))
+(test-assert "haskell-stackage"
+  (let* ((stackage (string-append "{ \"packages\": [{"
+                                  "    \"name\":\"x\","
+                                  "    \"version\":\"1.0\" }]}"))
+         (packages (map (lambda (version)
+                          (dummy-package
+                           (string-append "ghc-x")
+                           (version version)
+                           (source
+                            (dummy-origin
+                             (method url-fetch)
+                             (uri (string-append
+                                   "https://hackage.haskell.org/package/"
+                                   "x-" version "/x-" version ".tar.gz"))))))
+                        '("0.9" "1.0" "2.0")))
+         (warnings (pk (with-http-server `((200 ,stackage) ; memoized
+                                           (200 "name: x\nversion: 1.0\n")
+                                           (200 "name: x\nversion: 1.0\n")
+                                           (200 "name: x\nversion: 1.0\n"))
+                         (parameterize ((%hackage-url (%local-url))
+                                        (%stackage-url (%local-url)))
+                           (append-map check-haskell-stackage packages))))))
+    (match warnings
+      (((? lint-warning? warning))
+       (and (string=? (package-version (lint-warning-package warning)) "2.0")
+            (string-contains (lint-warning-message warning)
+                             "ahead of Stackage LTS version"))))))
+
 (test-end "lint")
 
 ;; Local Variables:
diff --git a/tests/packages.scm b/tests/packages.scm
index a9560a99a3..a867f2fd6d 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1463,6 +1463,49 @@
             (eq? foo grep)
             (eq? bar dep))))))
 
+(test-assert "package-input-rewriting/spec, identity"
+  ;; Make sure that 'package-input-rewriting/spec' doesn't gratuitously
+  ;; introduce variants.  In this case, the LIBFFI propagated input should not
+  ;; be duplicated when passing GOBJECT through REWRITE.
+  ;; See <https://issues.guix.gnu.org/43890>.
+  (let* ((libffi  (dummy-package "libffi"
+                    (build-system trivial-build-system)))
+         (glib    (dummy-package "glib"
+                    (build-system trivial-build-system)
+                    (propagated-inputs `(("libffi" ,libffi)))))
+         (gobject (dummy-package "gobject-introspection"
+                    (build-system trivial-build-system)
+                    (inputs `(("glib" ,glib)))
+                    (propagated-inputs `(("libffi" ,libffi)))))
+         (rewrite (package-input-rewriting/spec
+                   `(("glib" . ,identity)))))
+    (and (= (length (package-transitive-inputs gobject))
+            (length (package-transitive-inputs (rewrite gobject))))
+         (string=? (derivation-file-name
+                    (package-derivation %store (rewrite gobject)))
+                   (derivation-file-name
+                    (package-derivation %store gobject))))))
+
+(test-assert "package-input-rewriting, identity"
+  ;; Similar to the test above, but with 'package-input-rewriting'.
+  ;; See <https://issues.guix.gnu.org/43890>.
+  (let* ((libffi  (dummy-package "libffi"
+                    (build-system trivial-build-system)))
+         (glib    (dummy-package "glib"
+                    (build-system trivial-build-system)
+                    (propagated-inputs `(("libffi" ,libffi)))))
+         (gobject (dummy-package "gobject-introspection"
+                    (build-system trivial-build-system)
+                    (inputs `(("glib" ,glib)))
+                    (propagated-inputs `(("libffi" ,libffi)))))
+         (rewrite (package-input-rewriting `((,glib . ,glib)))))
+    (and (= (length (package-transitive-inputs gobject))
+            (length (package-transitive-inputs (rewrite gobject))))
+         (string=? (derivation-file-name
+                    (package-derivation %store (rewrite gobject)))
+                   (derivation-file-name
+                    (package-derivation %store gobject))))))
+
 (test-equal "package-patched-vulnerabilities"
   '(("CVE-2015-1234")
     ("CVE-2016-1234" "CVE-2018-4567")
diff --git a/tests/publish.scm b/tests/publish.scm
index 1c3b2785fb..cafd0f13a2 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;; Copyright © 2020 by Amar M. Singh <nly@disroot.org>
 ;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -412,7 +413,8 @@ References: ~%"
                     (call-with-new-thread
                      (lambda ()
                        (guix-publish "--port=6797" "-C2"
-                                     (string-append "--cache=" cache)))))))
+                                     (string-append "--cache=" cache)
+                                     "--cache-bypass-threshold=0"))))))
        (wait-until-ready 6797)
        (let* ((base     "http://localhost:6797/")
               (part     (store-path-hash-part %item))
@@ -432,6 +434,11 @@ References: ~%"
                  (< ttl 3600)))
 
               (wait-for-file cached)
+
+              ;; Both the narinfo and nar should be world-readable.
+              (= #o644 (stat:perms (lstat cached)))
+              (= #o644 (stat:perms (lstat nar)))
+
               (let* ((body         (http-get-port url))
                      (compressed   (http-get nar-url))
                      (uncompressed (http-get (string-append base "nar/"
@@ -461,7 +468,8 @@ References: ~%"
                     (call-with-new-thread
                      (lambda ()
                        (guix-publish "--port=6794" "-Cgzip:2" "-Clzip:2"
-                                     (string-append "--cache=" cache)))))))
+                                     (string-append "--cache=" cache)
+                                     "--cache-bypass-threshold=0"))))))
        (wait-until-ready 6794)
        (let* ((base     "http://localhost:6794/")
               (part     (store-path-hash-part %item))
@@ -516,7 +524,8 @@ References: ~%"
                       (call-with-new-thread
                        (lambda ()
                          (guix-publish "--port=6796" "-C2" "--ttl=42h"
-                                       (string-append "--cache=" cache)))))))
+                                       (string-append "--cache=" cache)
+                                       "--cache-bypass-threshold=0"))))))
          (wait-until-ready 6796)
          (let* ((base     "http://localhost:6796/")
                 (part     (store-path-hash-part item))
@@ -580,12 +589,79 @@ References: ~%"
                                        (basename item)
                                        ".narinfo"))
               (response (http-get url)))
-         (and (= 404 (response-code response))
+         (and (= 200 (response-code response))    ;we're below the threshold
               (wait-for-file cached)
               (begin
                 (delete-paths %store (list item))
                 (response-code (pk 'response (http-get url))))))))))
 
+(test-equal "with cache, cache bypass"
+  200
+  (call-with-temporary-directory
+   (lambda (cache)
+     (let ((thread (with-separate-output-ports
+                    (call-with-new-thread
+                     (lambda ()
+                       (guix-publish "--port=6788" "-C" "gzip"
+                                     (string-append "--cache=" cache)))))))
+       (wait-until-ready 6788)
+
+       (let* ((base     "http://localhost:6788/")
+              (item     (add-text-to-store %store "random" (random-text)))
+              (part     (store-path-hash-part item))
+              (narinfo  (string-append base part ".narinfo"))
+              (nar      (string-append base "nar/gzip/" (basename item)))
+              (cached   (string-append cache "/gzip/" (basename item)
+                                       ".narinfo")))
+         ;; We're below the default cache bypass threshold, so NAR and NARINFO
+         ;; should immediately return 200.  The NARINFO request should trigger
+         ;; caching, and the next request to NAR should return 200 as well.
+         (and (let ((response (pk 'r1 (http-get nar))))
+                (and (= 200 (response-code response))
+                     (not (response-content-length response)))) ;not known
+              (= 200 (response-code (http-get narinfo)))
+              (begin
+                (wait-for-file cached)
+                (let ((response (pk 'r2 (http-get nar))))
+                  (and (> (response-content-length response)
+                          (stat:size (stat item)))
+                       (response-code response))))))))))
+
+(test-equal "with cache, cache bypass, unmapped hash part"
+  200
+
+  ;; This test reproduces the bug described in <https://bugs.gnu.org/44442>:
+  ;; the daemon connection would be closed as a side effect of a nar request
+  ;; for a non-existing file name.
+  (call-with-temporary-directory
+   (lambda (cache)
+     (let ((thread (with-separate-output-ports
+                    (call-with-new-thread
+                     (lambda ()
+                       (guix-publish "--port=6787" "-C" "gzip"
+                                     (string-append "--cache=" cache)))))))
+       (wait-until-ready 6787)
+
+       (let* ((base     "http://localhost:6787/")
+              (item     (add-text-to-store %store "random" (random-text)))
+              (part     (store-path-hash-part item))
+              (narinfo  (string-append base part ".narinfo"))
+              (nar      (string-append base "nar/gzip/" (basename item)))
+              (cached   (string-append cache "/gzip/" (basename item)
+                                       ".narinfo")))
+         ;; The first response used to be 500 and to terminate the daemon
+         ;; connection as a side effect.
+         (and (= (response-code
+                  (http-get (string-append base "nar/gzip/"
+                                           (make-string 32 #\e)
+                                           "-does-not-exist")))
+                 404)
+              (= 200 (response-code (http-get nar)))
+              (= 200 (response-code (http-get narinfo)))
+              (begin
+                (wait-for-file cached)
+                (response-code (http-get nar)))))))))
+
 (test-equal "/log/NAME"
   `(200 #t application/x-bzip2)
   (let ((drv (run-with-store %store
@@ -613,6 +689,10 @@ References: ~%"
   (let ((uri (publish-uri "/log/does-not-exist")))
     (response-code (http-get uri))))
 
+(test-equal "/signing-key.pub"
+  200
+  (response-code (http-get (publish-uri "/signing-key.pub"))))
+
 (test-equal "non-GET query"
   '(200 404)
   (let ((path (string-append "/" (store-path-hash-part %item)
diff --git a/tests/store-database.scm b/tests/store-database.scm
index 4d91884250..3b4ef43f6d 100644
--- a/tests/store-database.scm
+++ b/tests/store-database.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +21,8 @@
   #:use-module (guix store)
   #:use-module (guix store database)
   #:use-module ((guix utils) #:select (call-with-temporary-output-file))
+  #:use-module ((guix build utils)
+                #:select (mkdir-p delete-file-recursively))
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-64))
 
@@ -55,6 +57,28 @@
            (list (stat:mtime (lstat file))
                  (stat:mtime (lstat ref)))))))
 
+(test-equal "register-path, directory"
+  '(1 1 1)
+  (let ((file (string-append (%store-prefix) "/" (make-string 32 #\f)
+                             "-fake-directory")))
+    (when (valid-path? %store file)
+      (delete-paths %store (list file)))
+    (false-if-exception (delete-file-recursively file))
+
+    (let ((drv (string-append file ".drv")))
+      (mkdir-p (string-append file "/a"))
+      (call-with-output-file (string-append file "/a/b")
+        (const #t))
+      (register-path file #:deriver drv)
+
+      (and (valid-path? %store file)
+           (null? (references %store file))
+           (null? (valid-derivers %store file))
+           (null? (referrers %store file))
+           (list (stat:mtime (lstat file))
+                 (stat:mtime (lstat (string-append file "/a")))
+                 (stat:mtime (lstat (string-append file "/a/b"))))))))
+
 (test-equal "new database"
   (list 1 2)
   (call-with-temporary-output-file
diff --git a/tests/scripts-build.scm b/tests/transformations.scm
index 6925374baa..07ed8b1234 100644
--- a/tests/scripts-build.scm
+++ b/tests/transformations.scm
@@ -16,15 +16,16 @@
 ;;; 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-scripts-build)
+(define-module (test-transformations)
   #:use-module (guix tests)
   #:use-module (guix store)
+  #:use-module ((guix gexp) #:select (lower-object))
   #:use-module (guix derivations)
   #:use-module (guix packages)
   #:use-module (guix git-download)
   #:use-module (guix build-system)
   #:use-module (guix build-system gnu)
-  #:use-module (guix scripts build)
+  #:use-module (guix transformations)
   #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix git)
@@ -37,13 +38,12 @@
   #:use-module (srfi srfi-64))
 
 
-(test-begin "scripts-build")
+(test-begin "transformations")
 
 (test-assert "options->transformation, no transformations"
   (let ((p (dummy-package "foo"))
         (t (options->transformation '())))
-    (with-store store
-      (eq? (t store p) p))))
+    (eq? (t p) p)))
 
 (test-assert "options->transformation, with-source"
   ;; Our pseudo-package is called 'guix.scm' so the 'guix.scm' source should
@@ -52,9 +52,11 @@
          (s (search-path %load-path "guix.scm"))
          (t (options->transformation `((with-source . ,s)))))
     (with-store store
-      (let ((new (t store p)))
+      (let* ((new (t p))
+             (source (run-with-store store
+                       (lower-object (package-source new)))))
         (and (not (eq? new p))
-             (string=? (package-source new)
+             (string=? source
                        (add-to-store store "guix.scm" #t
                                      "sha256" s)))))))
 
@@ -64,12 +66,9 @@
   (let* ((p (dummy-package "guix.scm" (replacement coreutils)))
          (s (search-path %load-path "guix.scm"))
          (t (options->transformation `((with-source . ,s)))))
-    (with-store store
-      (let ((new (t store p)))
-        (and (not (eq? new p))
-             (string=? (package-source new)
-                       (add-to-store store "guix.scm" #t "sha256" s))
-             (not (package-replacement new)))))))
+    (let ((new (t p)))
+      (and (not (eq? new p))
+           (not (package-replacement new))))))
 
 (test-assert "options->transformation, with-source, with version"
   ;; Our pseudo-package is called 'guix.scm' so the 'guix.scm-2.0' source
@@ -82,11 +81,13 @@
               (t (options->transformation `((with-source . ,f)))))
          (copy-file s f)
          (with-store store
-           (let ((new (t store p)))
+           (let* ((new (t p))
+                  (source (run-with-store store
+                            (lower-object (package-source new)))))
              (and (not (eq? new p))
                   (string=? (package-name new) (package-name p))
                   (string=? (package-version new) "42.0")
-                  (string=? (package-source new)
+                  (string=? source
                             (add-to-store store (basename f) #t
                                           "sha256" f))))))))))
 
@@ -95,13 +96,12 @@
   (let* ((p (dummy-package "foobar"))
          (s (search-path %load-path "guix.scm"))
          (t (options->transformation `((with-source . ,s)))))
-    (with-store store
-      (let* ((port (open-output-string))
-             (new  (parameterize ((guix-warning-port port))
-                     (t store p))))
-        (and (eq? new p)
-             (string-contains (get-output-string port)
-                              "had no effect"))))))
+    (let* ((port (open-output-string))
+           (new  (parameterize ((guix-warning-port port))
+                   (t p))))
+      (and (eq? new p)
+           (string-contains (get-output-string port)
+                            "had no effect")))))
 
 (test-assert "options->transformation, with-source, PKG=URI"
   (let* ((p (dummy-package "foo"))
@@ -109,12 +109,14 @@
          (f (string-append "foo=" s))
          (t (options->transformation `((with-source . ,f)))))
     (with-store store
-      (let ((new (t store p)))
+      (let* ((new (t p))
+             (source (run-with-store store
+                       (lower-object (package-source new)))))
         (and (not (eq? new p))
              (string=? (package-name new) (package-name p))
              (string=? (package-version new)
                        (package-version p))
-             (string=? (package-source new)
+             (string=? source
                        (add-to-store store (basename s) #t
                                      "sha256" s)))))))
 
@@ -124,11 +126,13 @@
          (f (string-append "foo@42.0=" s))
          (t (options->transformation `((with-source . ,f)))))
     (with-store store
-      (let ((new (t store p)))
+      (let* ((new (t p))
+             (source (run-with-store store
+                       (lower-object (package-source new)))))
         (and (not (eq? new p))
              (string=? (package-name new) (package-name p))
              (string=? (package-version new) "42.0")
-             (string=? (package-source new)
+             (string=? source
                        (add-to-store store (basename s) #t
                                      "sha256" s)))))))
 
@@ -140,20 +144,19 @@
                                   (native-inputs `(("x" ,grep)))))))))
          (t (options->transformation '((with-input . "coreutils=busybox")
                                        (with-input . "grep=findutils")))))
-    (with-store store
-      (let ((new (t store p)))
-        (and (not (eq? new p))
-             (match (package-inputs new)
-               ((("foo" dep1) ("bar" dep2) ("baz" dep3))
-                (and (string=? (package-full-name dep1)
-                               (package-full-name busybox))
-                     (string=? (package-full-name dep2)
-                               (package-full-name findutils))
-                     (string=? (package-name dep3) "chbouib")
-                     (match (package-native-inputs dep3)
-                       ((("x" dep))
-                        (string=? (package-full-name dep)
-                                  (package-full-name findutils))))))))))))
+    (let ((new (t p)))
+      (and (not (eq? new p))
+           (match (package-inputs new)
+             ((("foo" dep1) ("bar" dep2) ("baz" dep3))
+              (and (string=? (package-full-name dep1)
+                             (package-full-name busybox))
+                   (string=? (package-full-name dep2)
+                             (package-full-name findutils))
+                   (string=? (package-name dep3) "chbouib")
+                   (match (package-native-inputs dep3)
+                     ((("x" dep))
+                      (string=? (package-full-name dep)
+                                (package-full-name findutils)))))))))))
 
 (test-assert "options->transformation, with-graft"
   (let* ((p (dummy-package "guix.scm"
@@ -161,23 +164,22 @@
                         ("bar" ,(dummy-package "chbouib"
                                   (native-inputs `(("x" ,grep)))))))))
          (t (options->transformation '((with-graft . "grep=findutils")))))
-    (with-store store
-      (let ((new (t store p)))
-        (and (not (eq? new p))
-             (match (package-inputs new)
-               ((("foo" dep1) ("bar" dep2))
-                (and (string=? (package-full-name dep1)
-                               (package-full-name grep))
-                     (string=? (package-full-name (package-replacement dep1))
-                               (package-full-name findutils))
-                     (string=? (package-name dep2) "chbouib")
-                     (match (package-native-inputs dep2)
-                       ((("x" dep))
-                        (with-store store
-                          (string=? (derivation-file-name
-                                     (package-derivation store findutils))
-                                    (derivation-file-name
-                                     (package-derivation store dep))))))))))))))
+    (let ((new (t p)))
+      (and (not (eq? new p))
+           (match (package-inputs new)
+             ((("foo" dep1) ("bar" dep2))
+              (and (string=? (package-full-name dep1)
+                             (package-full-name grep))
+                   (string=? (package-full-name (package-replacement dep1))
+                             (package-full-name findutils))
+                   (string=? (package-name dep2) "chbouib")
+                   (match (package-native-inputs dep2)
+                     ((("x" dep))
+                      (with-store store
+                        (string=? (derivation-file-name
+                                   (package-derivation store findutils))
+                                  (derivation-file-name
+                                   (package-derivation store dep)))))))))))))
 
 (test-equal "options->transformation, with-branch"
   (git-checkout (url "https://example.org")
@@ -193,15 +195,14 @@
                                                   (commit "cabba9e")))
                                             (sha256 #f)))))))))
          (t (options->transformation '((with-branch . "chbouib=devel")))))
-    (with-store store
-      (let ((new (t store p)))
-        (and (not (eq? new p))
-             (match (package-inputs new)
-               ((("foo" dep1) ("bar" dep2))
-                (and (string=? (package-full-name dep1)
-                               (package-full-name grep))
-                     (string=? (package-name dep2) "chbouib")
-                     (package-source dep2)))))))))
+    (let ((new (t p)))
+      (and (not (eq? new p))
+           (match (package-inputs new)
+             ((("foo" dep1) ("bar" dep2))
+              (and (string=? (package-full-name dep1)
+                             (package-full-name grep))
+                   (string=? (package-name dep2) "chbouib")
+                   (package-source dep2))))))))
 
 (test-equal "options->transformation, with-commit"
   (git-checkout (url "https://example.org")
@@ -217,15 +218,14 @@
                                                   (commit "cabba9e")))
                                             (sha256 #f)))))))))
          (t (options->transformation '((with-commit . "chbouib=abcdef")))))
-    (with-store store
-      (let ((new (t store p)))
-        (and (not (eq? new p))
-             (match (package-inputs new)
-               ((("foo" dep1) ("bar" dep2))
-                (and (string=? (package-full-name dep1)
-                               (package-full-name grep))
-                     (string=? (package-name dep2) "chbouib")
-                     (package-source dep2)))))))))
+    (let ((new (t p)))
+      (and (not (eq? new p))
+           (match (package-inputs new)
+             ((("foo" dep1) ("bar" dep2))
+              (and (string=? (package-full-name dep1)
+                             (package-full-name grep))
+                   (string=? (package-name dep2) "chbouib")
+                   (package-source dep2))))))))
 
 (test-equal "options->transformation, with-git-url"
   (let ((source (git-checkout (url "https://example.org")
@@ -236,17 +236,16 @@
                         ("bar" ,(dummy-package "chbouib"
                                   (native-inputs `(("x" ,grep)))))))))
          (t (options->transformation '((with-git-url . "grep=https://example.org")))))
-    (with-store store
-      (let ((new (t store p)))
-        (and (not (eq? new p))
-             (match (package-inputs new)
-               ((("foo" dep1) ("bar" dep2))
-                (and (string=? (package-full-name dep1)
-                               (package-full-name grep))
-                     (string=? (package-name dep2) "chbouib")
-                     (match (package-native-inputs dep2)
-                       ((("x" dep3))
-                        (map package-source (list dep1 dep3))))))))))))
+    (let ((new (t p)))
+      (and (not (eq? new p))
+           (match (package-inputs new)
+             ((("foo" dep1) ("bar" dep2))
+              (and (string=? (package-full-name dep1)
+                             (package-full-name grep))
+                   (string=? (package-name dep2) "chbouib")
+                   (match (package-native-inputs dep2)
+                     ((("x" dep3))
+                      (map package-source (list dep1 dep3)))))))))))
 
 (test-equal "options->transformation, with-git-url + with-branch"
   ;; Combine the two options and make sure the 'with-branch' transformation
@@ -263,16 +262,15 @@
              (reverse '((with-git-url
                          . "grep=https://example.org")
                         (with-branch . "grep=BRANCH"))))))
-    (with-store store
-      (let ((new (t store p)))
-        (and (not (eq? new p))
-             (match (package-inputs new)
-               ((("foo" dep1) ("bar" dep2))
-                (and (string=? (package-name dep1) "grep")
-                     (string=? (package-name dep2) "chbouib")
-                     (match (package-native-inputs dep2)
-                       ((("x" dep3))
-                        (map package-source (list dep1 dep3))))))))))))
+    (let ((new (t p)))
+      (and (not (eq? new p))
+           (match (package-inputs new)
+             ((("foo" dep1) ("bar" dep2))
+              (and (string=? (package-name dep1) "grep")
+                   (string=? (package-name dep2) "chbouib")
+                   (match (package-native-inputs dep2)
+                     ((("x" dep3))
+                      (map package-source (list dep1 dep3)))))))))))
 
 (define* (depends-on-toolchain? p #:optional (toolchain "gcc-toolchain"))
   "Return true if P depends on TOOLCHAIN instead of the default tool chain."
@@ -302,21 +300,20 @@
     ;; Here we check that the transformation applies to DEP0 and all its
     ;; dependents: DEP0 must use GCC-TOOLCHAIN, DEP1 must use GCC-TOOLCHAIN
     ;; and the DEP0 that uses GCC-TOOLCHAIN, and so on.
-    (with-store store
-      (let ((new (t store p)))
-        (and (depends-on-toolchain? new "gcc-toolchain")
-             (match (bag-build-inputs (package->bag new))
-               ((("foo" dep0) ("bar" dep1) _ ...)
-                (and (depends-on-toolchain? dep1 "gcc-toolchain")
-                     (not (depends-on-toolchain? dep0 "gcc-toolchain"))
-                     (string=? (package-full-name dep0)
-                               (package-full-name grep))
-                     (match (bag-build-inputs (package->bag dep1))
-                       ((("x" dep) _ ...)
-                        (and (depends-on-toolchain? dep "gcc-toolchain")
-                             (match (bag-build-inputs (package->bag dep))
-                               ((("y" dep) _ ...) ;this one is unchanged
-                                (eq? dep grep))))))))))))))
+    (let ((new (t p)))
+      (and (depends-on-toolchain? new "gcc-toolchain")
+           (match (bag-build-inputs (package->bag new))
+             ((("foo" dep0) ("bar" dep1) _ ...)
+              (and (depends-on-toolchain? dep1 "gcc-toolchain")
+                   (not (depends-on-toolchain? dep0 "gcc-toolchain"))
+                   (string=? (package-full-name dep0)
+                             (package-full-name grep))
+                   (match (bag-build-inputs (package->bag dep1))
+                     ((("x" dep) _ ...)
+                      (and (depends-on-toolchain? dep "gcc-toolchain")
+                           (match (bag-build-inputs (package->bag dep))
+                             ((("y" dep) _ ...)   ;this one is unchanged
+                              (eq? dep grep)))))))))))))
 
 (test-equal "options->transformation, with-c-toolchain twice"
   (package-full-name grep)
@@ -330,23 +327,37 @@
          (t    (options->transformation
                 '((with-c-toolchain . "chbouib=clang-toolchain")
                   (with-c-toolchain . "stuff=clang-toolchain")))))
-    (with-store store
-      (let ((new (t store p)))
-        (and (depends-on-toolchain? new "clang-toolchain")
-             (match (bag-build-inputs (package->bag new))
-               ((("foo" dep0) ("bar" dep1) ("baz" dep2) _ ...)
-                (and (depends-on-toolchain? dep0 "clang-toolchain")
-                     (depends-on-toolchain? dep1 "clang-toolchain")
-                     (not (depends-on-toolchain? dep2 "clang-toolchain"))
-                     (package-full-name dep2)))))))))
+    (let ((new (t p)))
+      (and (depends-on-toolchain? new "clang-toolchain")
+           (match (bag-build-inputs (package->bag new))
+             ((("foo" dep0) ("bar" dep1) ("baz" dep2) _ ...)
+              (and (depends-on-toolchain? dep0 "clang-toolchain")
+                   (depends-on-toolchain? dep1 "clang-toolchain")
+                   (not (depends-on-toolchain? dep2 "clang-toolchain"))
+                   (package-full-name dep2))))))))
 
 (test-assert "options->transformation, with-c-toolchain, no effect"
   (let ((p (dummy-package "thingie"))
         (t (options->transformation
             '((with-c-toolchain . "does-not-exist=gcc-toolchain")))))
     ;; When it has no effect, '--with-c-toolchain' returns P.
-    (with-store store
-      (eq? (t store p) p))))
+    (eq? (t p) p)))
+
+(test-equal "options->transformation, with-debug-info"
+  '(#:strip-binaries? #f)
+  (let* ((dep  (dummy-package "chbouib"))
+         (p    (dummy-package "thingie"
+                 (build-system gnu-build-system)
+                 (inputs `(("foo" ,dep)
+                           ("bar" ,grep)))))
+         (t    (options->transformation
+                '((with-debug-info . "chbouib")))))
+    (let ((new (t p)))
+      (match (package-inputs new)
+        ((("foo" dep0) ("bar" dep1))
+         (and (string=? (package-full-name dep1)
+                        (package-full-name grep))
+              (package-arguments (package-replacement dep0))))))))
 
 (test-assert "options->transformation, without-tests"
   (let* ((dep (dummy-package "dep"))
@@ -354,14 +365,13 @@
                 (inputs `(("dep" ,dep)))))
          (t   (options->transformation '((without-tests . "dep")
                                          (without-tests . "tar")))))
-    (with-store store
-      (let ((new (t store p)))
-        (match (bag-direct-inputs (package->bag new))
-          ((("dep" dep) ("tar" tar) _ ...)
-           ;; TODO: Check whether TAR has #:tests? #f when transformations
-           ;; apply to implicit inputs.
-           (equal? (package-arguments dep)
-                   '(#:tests? #f))))))))
+    (let ((new (t p)))
+      (match (bag-direct-inputs (package->bag new))
+        ((("dep" dep) ("tar" tar) _ ...)
+         ;; TODO: Check whether TAR has #:tests? #f when transformations
+         ;; apply to implicit inputs.
+         (equal? (package-arguments dep)
+                 '(#:tests? #f)))))))
 
 (test-end)