Merge branch 'master' into staging

16 files changed, 447 insertions, 68 deletions

diff --git a/tests/gexp.scm b/tests/gexp.scm
index 3c8b4624da..a560adfc5c 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -23,6 +23,7 @@
   #:use-module (guix grafts)
   #:use-module (guix derivations)
   #:use-module (guix packages)
+  #:use-module (guix build-system trivial)
   #:use-module (guix tests)
   #:use-module ((guix build utils) #:select (with-directory-excursion))
   #:use-module ((guix utils) #:select (call-with-temporary-directory))
@@ -66,6 +67,27 @@
     (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"
+                 (build-system trivial-build-system)
+                 (arguments
+                  `(#:guile ,%bootstrap-guile
+                    #:modules ((guix build utils))
+                    #:builder
+                    (begin
+                      (use-modules (guix build utils))
+                      (let* ((out (string-append (assoc-ref %outputs "out")
+                                                 "/share/guile/site/"
+                                                 (effective-version))))
+                        (mkdir-p out)
+                        (call-with-output-file (string-append out "/hg2g.scm")
+                          (lambda (port)
+                            (write '(define-module (hg2g)
+                                      #:export (the-answer))
+                                   port)
+                            (write '(define the-answer 42) port)))))))))
+
 
 (test-begin "gexp")
 
@@ -739,6 +761,54 @@
       (built-derivations (list drv))
       (return (= 42 (call-with-input-file out read))))))
 
+(test-equal "gexp-extensions & ungexp"
+  (list sed grep)
+  ((@@ (guix gexp) gexp-extensions)
+   #~(foo #$(with-extensions (list grep) #~+)
+          #+(with-extensions (list sed)  #~-))))
+
+(test-equal "gexp-extensions & ungexp-splicing"
+  (list grep sed)
+  ((@@ (guix gexp) gexp-extensions)
+   #~(foo #$@(list (with-extensions (list grep) #~+)
+                   (with-imported-modules '((foo))
+                     (with-extensions (list sed) #~-))))))
+
+(test-equal "gexp-extensions and literal Scheme object"
+  '()
+  ((@@ (guix gexp) gexp-extensions) #t))
+
+(test-assertm "gexp->derivation & with-extensions"
+  ;; Create a fake Guile extension and make sure it is accessible both to the
+  ;; imported modules and to the derivation build script.
+  (mlet* %store-monad
+      ((extension -> %extension-package)
+       (module -> (scheme-file "x" #~( ;; splice!
+                                      (define-module (foo)
+                                        #:use-module (hg2g)
+                                        #:export (multiply))
+
+                                      (define (multiply x)
+                                        (* the-answer x)))
+                               #:splice? #t))
+       (build -> (with-extensions (list extension)
+                   (with-imported-modules `((guix build utils)
+                                            ((foo) => ,module))
+                     #~(begin
+                         (use-modules (guix build utils)
+                                      (hg2g) (foo))
+                         (call-with-output-file #$output
+                           (lambda (port)
+                             (write (list the-answer (multiply 2))
+                                    port)))))))
+       (drv      (gexp->derivation "thingie" build
+                                   ;; %BOOTSTRAP-GUILE is 2.0.
+                                   #:effective-version "2.0"))
+       (out ->   (derivation->output-path drv)))
+    (mbegin %store-monad
+      (built-derivations (list drv))
+      (return (equal? '(42 84) (call-with-input-file out read))))))
+
 (test-assertm "gexp->derivation #:references-graphs"
   (mlet* %store-monad
       ((one (text-file "one" (random-text)))
@@ -948,6 +1018,22 @@
              (return (and (zero? (close-pipe pipe))
                           (string=? text str))))))))))
 
+(test-assertm "program-file & with-extensions"
+  (let* ((exp    (with-extensions (list %extension-package)
+                   (gexp (begin
+                           (use-modules (hg2g))
+                           (display the-answer)))))
+         (file   (program-file "program" exp
+                               #:guile %bootstrap-guile)))
+    (mlet* %store-monad ((drv (lower-object file))
+                         (out -> (derivation->output-path drv)))
+      (mbegin %store-monad
+        (built-derivations (list drv))
+        (let* ((pipe  (open-input-pipe out))
+               (str   (get-string-all pipe)))
+          (return (and (zero? (close-pipe pipe))
+                       (= 42 (string->number str)))))))))
+
 (test-assertm "scheme-file"
   (let* ((text   (plain-file "foo" "Hello, world!"))
          (scheme (scheme-file "bar" #~(list "foo" #$text))))
diff --git a/tests/graph.scm b/tests/graph.scm
index 5faa19298a..4799d3bd0c 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -134,7 +134,7 @@ edges."
                      (map (lambda (destination)
                             (list "p-0.drv"
                                   (string-append
-                                   (package-full-name destination)
+                                   (package-full-name destination "-")
                                    ".drv")))
                           implicit)))))))
 
@@ -293,7 +293,7 @@ edges."
   (run-with-store %store
     (let ((packages (fold-packages cons '())))
       (mlet %store-monad ((edges (node-edges %package-node-type packages)))
-        (return (and (null? (edges sed))
+        (return (and (null? (edges hello))
                      (lset= eq?
                             (edges guile-2.0)
                             (match (package-direct-inputs guile-2.0)
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index b84723fa43..92e7299321 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2013, 2014, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2013, 2014, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -138,6 +138,25 @@ test `guix build -d --sources=transitive foo \
       | grep -e 'foo\.tar\.gz' -e 'bar\.tar\.gz' -e 'bar\.dat' \
       | wc -l` -eq 3
 
+
+# Unbound variables.
+cat > "$module_dir/foo.scm"<<EOF
+(define-module (foo)
+  #:use-module (guix tests)
+  #:use-module (guix build-system trivial))
+
+(define-public foo
+  (dummy-package "package-with-something-wrong"
+    (build-system trivial-build-system)
+    (inputs (quasiquote (("sed" ,sed))))))  ;unbound variable
+EOF
+
+if guix build package-with-something-wrong -n; then false; else true; fi
+guix build package-with-something-wrong -n 2> "$module_dir/err" || true
+grep "unbound" "$module_dir/err"		     # actual error
+grep "forget.*(gnu packages base)" "$module_dir/err" # hint
+rm -f "$module_dir"/*
+
 # Should all return valid log files.
 drv="`guix build -d -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`"
 out="`guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`"
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index 1b63b957be..917d52451c 100644
--- a/tests/guix-pack.sh
+++ b/tests/guix-pack.sh
@@ -35,18 +35,23 @@ export GUIX_BUILD_OPTIONS
 # Build a tarball with no compression.
 guix pack --compression=none --bootstrap guile-bootstrap
 
-# Build a tarball (with compression).
-guix pack --bootstrap guile-bootstrap
+# Build a tarball (with compression).  Check that '-e' works as well.
+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 --bootstrap -S /opt/gnu/bin=bin guile-bootstrap`"
 
-# Try to extract it.
+# 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
 cd "$test_directory"
 tar -xf "$the_pack"
-test -x opt/gnu/bin/guile
+test -L opt/gnu/bin
 
 is_available () {
     # Use the "type" shell builtin to see if the program is on PATH.
@@ -81,3 +86,14 @@ guix pack --dry-run --bootstrap -f docker -S /opt/gnu=/ guile-bootstrap
 # Build a tarball pack of cross-compiled software.  Use coreutils because
 # guile-bootstrap is not intended to be cross-compiled.
 guix pack --dry-run --bootstrap --target=arm-unknown-linux-gnueabihf coreutils
+
+# Likewise, 'guix pack -R' requires a full-blown toolchain (because
+# 'glibc-bootstrap' lacks 'libc.a'), hence '--dry-run'.
+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`"
+test -n "$drv1"
+test "$drv1" != "$drv2"
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index aa5eaa66e7..3b3fa35cd8 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -60,12 +60,12 @@ test -L "$profile" && test -L "$profile-1-link"
 ! test -f "$profile-2-link"
 test -f "$profile/bin/guile"
 
-# Collisions are properly flagged (in this case, 'python-wrapper' propagates
-# python@3, which conflicts with python@2.)
-if guix package --bootstrap -n -p "$profile" -i python@2 python-wrapper
+# Collisions are properly flagged (in this case, 'g-wrap' propagates
+# guile@2.2, which conflicts with guile@2.0.)
+if guix package --bootstrap -n -p "$profile" -i g-wrap guile@2.0
 then false; else true; fi
 
-guix package --bootstrap -n -p "$profile" -i python@2 python-wrapper \
+guix package --bootstrap -n -p "$profile" -i g-wrap guile@2.0 \
      --allow-collisions
 
 # No search path env. var. here.
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index ff9114ab74..36ba5fbd5f 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -111,8 +111,7 @@ cat > "$tmpfile" <<EOF
 
   (bootloader (GRUB-config (device "/dev/sdX")))      ; 9
   (file-systems (cons (file-system
-                        (device "root")
-                        (title 'label)
+                        (device (file-system-label "root"))
                         (mount-point "/")
                         (type "ext4"))
                       %base-file-systems)))
@@ -125,9 +124,9 @@ else
     then
 	# FIXME: With Guile 2.2.0 the error is reported on line 4.
 	# See <http://bugs.gnu.org/26107>.
-	grep "$tmpfile:[49]:[0-9]\+: GRUB-config.*[Uu]nbound variable" "$errorfile"
+	grep "$tmpfile:[49]:[0-9]\+:.*GRUB-config.*[Uu]nbound variable" "$errorfile"
     else
-	grep "$tmpfile:9:[0-9]\+: GRUB-config.*[Uu]nbound variable" "$errorfile"
+	grep "$tmpfile:9:[0-9]\+:.*GRUB-config.*[Uu]nbound variable" "$errorfile"
     fi
 fi
 
@@ -140,8 +139,7 @@ OS_BASE='
                (bootloader grub-bootloader)
                (device "/dev/sdX")))
   (file-systems (cons (file-system
-                        (device "root")
-                        (title (string->symbol "label"))
+                        (device (file-system-label "root"))
                         (mount-point "/")
                         (type "ext4"))
                       %base-file-systems))
@@ -213,8 +211,7 @@ make_user_config ()
                 (bootloader grub-bootloader)
                 (device "/dev/sdX")))
   (file-systems (cons (file-system
-                        (device "root")
-                        (title 'label)
+                        (device (file-system-label "root"))
                         (mount-point "/")
                         (type "ext4"))
                       %base-file-systems))
diff --git a/tests/pack.scm b/tests/pack.scm
index 3bce715075..d4596f863a 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -61,20 +62,20 @@
                                         #:symlinks '(("/bin/Guile"
                                                       -> "bin/guile"))
                                         #:compressor %gzip-compressor
-                                        #:tar %tar-bootstrap))
+                                        #:archiver %tar-bootstrap))
        (check   (gexp->derivation
                  "check-tarball"
-                 #~(let ((guile (string-append "." #$profile "/bin")))
+                 #~(let ((bin (string-append "." #$profile "/bin")))
                      (setenv "PATH"
                              (string-append #$%tar-bootstrap "/bin"))
                      (system* "tar" "xvf" #$tarball)
                      (mkdir #$output)
                      (exit
-                      (and (file-exists? (string-append guile "/guile"))
+                      (and (file-exists? (string-append bin "/guile"))
                            (string=? (string-append #$%bootstrap-guile "/bin")
-                                     (readlink guile))
-                           (string=? (string-append (string-drop guile 1)
-                                                    "/guile")
+                                     (readlink bin))
+                           (string=? (string-append ".." #$profile
+                                                    "/bin/guile")
                                      (readlink "bin/Guile"))))))))
     (built-derivations (list check))))
 
diff --git a/tests/packages.scm b/tests/packages.scm
index 9e19c3992e..65ccb14889 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -407,18 +407,23 @@
                                                         (%current-system)))))
                     (arguments
                      `(#:guile ,%bootstrap-guile
+                       #:modules ((guix build utils))
                        #:builder
-                       (let ((tar    (assoc-ref %build-inputs "tar"))
-                             (xz     (assoc-ref %build-inputs "xz"))
-                             (source (assoc-ref %build-inputs "source")))
-                         (and (zero? (system* tar "xvf" source
-                                              "--use-compress-program" xz))
-                              (string=? "guile" (readlink "bin/guile-rocks"))
-                              (file-exists? "bin/scripts/compile.scm")
-                              (let ((out (assoc-ref %outputs "out")))
-                                (call-with-output-file out
-                                  (lambda (p)
-                                    (display "OK" p))))))))))
+                       (begin
+                         (use-modules (guix build utils))
+                         (let ((tar    (assoc-ref %build-inputs "tar"))
+                               (xz     (assoc-ref %build-inputs "xz"))
+                               (source (assoc-ref %build-inputs "source")))
+                           (invoke tar "xvf" source
+                                   "--use-compress-program" xz)
+                           (unless (and (string=? "guile" (readlink "bin/guile-rocks"))
+                                        (file-exists? "bin/scripts/compile.scm"))
+                             (error "the snippet apparently failed"))
+                           (let ((out (assoc-ref %outputs "out")))
+                             (call-with-output-file out
+                               (lambda (p)
+                                 (display "OK" p))))
+                           #t))))))
          (drv    (package-derivation %store package))
          (out    (derivation->output-path drv)))
     (and (build-derivations %store (list (pk 'snippet-drv drv)))
@@ -486,7 +491,8 @@
                    (mkdir %output)
                    (call-with-output-file (string-append %output "/test")
                      (lambda (p)
-                       (display '(hello guix) p))))))))
+                       (display '(hello guix) p)))
+                   #t)))))
          (d (package-derivation %store p)))
     (and (build-derivations %store (list d))
          (let ((p (pk 'drv d (derivation->output-path d))))
@@ -500,8 +506,10 @@
               (source #f)
               (arguments
                `(#:guile ,%bootstrap-guile
-                 #:builder (copy-file (assoc-ref %build-inputs "input")
-                                      %output)))
+                 #:builder (begin
+                             (copy-file (assoc-ref %build-inputs "input")
+                                        %output)
+                             #t)))
               (inputs `(("input" ,i)))))
          (d (package-derivation %store p)))
     (and (build-derivations %store (list d))
@@ -516,8 +524,10 @@
               (source i)
               (arguments
                `(#:guile ,%bootstrap-guile
-                 #:builder (copy-file (assoc-ref %build-inputs "source")
-                                      %output)))))
+                 #:builder (begin
+                             (copy-file (assoc-ref %build-inputs "source")
+                                        %output)
+                             #t)))))
          (d (package-derivation %store p)))
     (and (build-derivations %store (list d))
          (let ((p (derivation->output-path d)))
@@ -530,11 +540,14 @@
               (source #f)
               (arguments
                `(#:guile ,%bootstrap-guile
+                 #:modules ((guix build utils))
                  #:builder
-                 (let ((out  (assoc-ref %outputs "out"))
-                       (bash (assoc-ref %build-inputs "bash")))
-                   (zero? (system* bash "-c"
-                                   (format #f "echo hello > ~a" out))))))
+                 (begin
+                   (use-modules (guix build utils))
+                   (let ((out  (assoc-ref %outputs "out"))
+                         (bash (assoc-ref %build-inputs "bash")))
+                     (invoke bash "-c"
+                             (format #f "echo hello > ~a" out))))))
               (inputs `(("bash" ,(search-bootstrap-binary "bash"
                                                           (%current-system)))))))
          (d (package-derivation %store p)))
@@ -554,7 +567,8 @@
                    (mkdir %output)
                    ;; The reference to itself isn't allowed so building it
                    ;; should fail.
-                   (symlink %output (string-append %output "/self")))))))
+                   (symlink %output (string-append %output "/self"))
+                   #t)))))
          (d (package-derivation %store p)))
     (guard (c ((nix-protocol-error? c) #t))
       (build-derivations %store (list d))
@@ -766,7 +780,9 @@
                 (inherit p1r) (name "p1") (replacement p1r)
                 (arguments
                  `(#:guile ,%bootstrap-guile
-                   #:builder (mkdir (assoc-ref %outputs "out"))))))
+                   #:builder (begin
+                               (mkdir (assoc-ref %outputs "out"))
+                               #t)))))
          (p2r (dummy-package "P2"
                 (build-system trivial-build-system)
                 (inputs `(("p1" ,p1)))
@@ -786,7 +802,8 @@
                                (mkdir out)
                                (chdir out)
                                (symlink (assoc-ref %build-inputs "p1")
-                                        "p1"))))))
+                                        "p1")
+                               #t)))))
          (p3  (dummy-package "p3"
                 (build-system trivial-build-system)
                 (inputs `(("p2" ,p2)))
@@ -796,7 +813,8 @@
                                (mkdir out)
                                (chdir out)
                                (symlink (assoc-ref %build-inputs "p2")
-                                        "p2")))))))
+                                        "p2")
+                               #t))))))
     (lset= equal?
            (package-grafts %store p3)
            (list (graft
@@ -941,6 +959,21 @@
                    ((("x" dep))
                     (eq? dep findutils)))))))))
 
+(test-equal "package-patched-vulnerabilities"
+  '(("CVE-2015-1234")
+    ("CVE-2016-1234" "CVE-2018-4567")
+    ())
+  (let ((p1 (dummy-package "pi"
+              (source (dummy-origin
+                       (patches (list "/a/b/pi-CVE-2015-1234.patch"))))))
+        (p2 (dummy-package "pi"
+              (source (dummy-origin
+                       (patches (list
+                                 "/a/b/pi-CVE-2016-1234-CVE-2018-4567.patch"))))))
+        (p3 (dummy-package "pi" (source (dummy-origin)))))
+    (map package-patched-vulnerabilities
+         (list p1 p2 p3))))
+
 (test-eq "fold-packages" hello
   (fold-packages (lambda (p r)
                    (if (string=? (package-name p) "hello")
@@ -990,7 +1023,8 @@
                                 (call-with-output-file
                                     (string-append out "/xml/bar/baz/catalog.xml")
                                   (lambda (port)
-                                    (display "xml? wat?!" port)))))))
+                                    (display "xml? wat?!" port)))
+                                #t))))
                (synopsis #f) (description #f)
                (home-page #f) (license #f)))
          (p2 (package
@@ -1001,7 +1035,9 @@
                (build-system trivial-build-system)
                (arguments
                 `(#:guile ,%bootstrap-guile
-                  #:builder (mkdir (assoc-ref %outputs "out"))))
+                  #:builder (begin
+                              (mkdir (assoc-ref %outputs "out"))
+                              #t)))
                (native-search-paths (package-native-search-paths libxml2))
                (synopsis #f) (description #f)
                (home-page #f) (license #f)))
@@ -1043,7 +1079,9 @@
                (build-system trivial-build-system)
                (arguments
                 `(#:guile ,%bootstrap-guile
-                  #:builder (mkdir (assoc-ref %outputs "out"))))
+                  #:builder (begin
+                              (mkdir (assoc-ref %outputs "out"))
+                              #t)))
                (native-search-paths (package-native-search-paths git))))
          (prof1 (run-with-store %store
                   (profile-derivation
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 92eb08cb9e..3a59a0cc4f 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -223,6 +223,52 @@
                  (string=? (dirname (readlink bindir))
                            (derivation->output-path guile))))))
 
+(test-assertm "profile-derivation relative symlinks, one entry"
+  (mlet* %store-monad
+      ((entry ->   (package->manifest-entry %bootstrap-guile))
+       (guile      (package->derivation %bootstrap-guile))
+       (drv        (profile-derivation (manifest (list entry))
+                                       #:relative-symlinks? #t
+                                       #:hooks '()
+                                       #:locales? #f))
+       (profile -> (derivation->output-path drv))
+       (bindir ->  (string-append profile "/bin"))
+       (_          (built-derivations (list drv))))
+    (return (and (file-exists? (string-append bindir "/guile"))
+                 (string=? (readlink bindir)
+                           (string-append "../"
+                                          (basename
+                                           (derivation->output-path guile))
+                                          "/bin"))))))
+
+(unless (network-reachable?) (test-skip 1))
+(test-assertm "profile-derivation relative symlinks, two entries"
+  (mlet* %store-monad
+      ((gnu-make-boot0 -> (@@ (gnu packages commencement) gnu-make-boot0))
+       (manifest -> (packages->manifest
+                     (list %bootstrap-guile gnu-make-boot0)))
+       (guile       (package->derivation %bootstrap-guile))
+       (make        (package->derivation gnu-make-boot0))
+       (drv         (profile-derivation manifest
+                                        #:relative-symlinks? #t
+                                        #:hooks '()
+                                        #:locales? #f))
+       (profile ->  (derivation->output-path drv))
+       (bindir ->   (string-append profile "/bin"))
+       (_           (built-derivations (list drv))))
+    (return (and (file-exists? (string-append bindir "/guile"))
+                 (file-exists? (string-append bindir "/make"))
+                 (string=? (readlink (string-append bindir "/guile"))
+                           (string-append "../../"
+                                          (basename
+                                           (derivation->output-path guile))
+                                          "/bin/guile"))
+                 (string=? (readlink (string-append bindir "/make"))
+                           (string-append "../../"
+                                          (basename
+                                           (derivation->output-path make))
+                                          "/bin/make"))))))
+
 (test-assertm "profile-derivation, inputs"
   (mlet* %store-monad
       ((entry ->   (package->manifest-entry packages:glibc "debug"))
@@ -242,8 +288,8 @@
                                         #:hooks '()
                                         #:locales? #t
                                         #:target target)))
-    (define (find-input name)
-      (let ((name (string-append name ".drv")))
+    (define (find-input package)
+      (let ((name (string-append (package-full-name package "-") ".drv")))
         (any (lambda (input)
                (let ((input (derivation-input-path input)))
                  (and (string-suffix? name input) input)))
@@ -252,12 +298,11 @@
     ;; The inputs for grep and sed should be cross-build derivations, but that
     ;; for the glibc-utf8-locales should be a native build.
     (return (and (string=? (derivation-system drv) (%current-system))
-                 (string=? (find-input (package-full-name packages:grep))
+                 (string=? (find-input packages:grep)
                            (derivation-file-name grep))
-                 (string=? (find-input (package-full-name packages:sed))
+                 (string=? (find-input packages:sed)
                            (derivation-file-name sed))
-                 (string=? (find-input
-                            (package-full-name packages:glibc-utf8-locales))
+                 (string=? (find-input packages:glibc-utf8-locales)
                            (derivation-file-name locales))))))
 
 (test-assert "package->manifest-entry defaults to \"out\""
@@ -453,7 +498,8 @@
                           (mkdir (string-append out "/etc"))
                           (call-with-output-file (string-append out "/etc/foo")
                             (lambda (port)
-                              (display "foo!" port))))))))
+                              (display "foo!" port)))
+                          #t)))))
        (entry ->   (package->manifest-entry thing))
        (drv        (profile-derivation (manifest (list entry))
                                        #:hooks '()
@@ -482,7 +528,8 @@
                           (symlink "foo" (string-append out "/etc"))
                           (call-with-output-file (string-append out "/etc/bar")
                             (lambda (port)
-                              (display "foo!" port))))))))
+                              (display "foo!" port)))
+                          #t)))))
        (entry ->   (package->manifest-entry thing))
        (drv        (profile-derivation (manifest (list entry))
                                        #:hooks '()
diff --git a/tests/records.scm b/tests/records.scm
index d6d27bb96a..80e08a9a5f 100644
--- a/tests/records.scm
+++ b/tests/records.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -288,6 +288,34 @@
       (and (string-match "extra.*initializer.*baz" message)
            (eq? proc 'foo)))))
 
+(test-assert "ABI checks"
+  (let ((module (test-module)))
+    (eval '(begin
+             (define-record-type* <foo> foo make-foo
+               foo?
+               (bar foo-bar (default 42)))
+
+             (define (make-me-a-record) (foo)))
+          module)
+    (unless (eval '(foo? (make-me-a-record)) module)
+      (error "what?" (eval '(make-me-a-record) module)))
+
+    ;; Redefine <foo> with an additional field.
+    (eval '(define-record-type* <foo> foo make-foo
+             foo?
+             (baz foo-baz)
+             (bar foo-bar (default 42)))
+          module)
+
+    ;; Now 'make-me-a-record' is out of sync because it does an
+    ;; 'allocate-struct' that corresponds to the previous definition of <foo>.
+    (catch 'record-abi-mismatch-error
+      (lambda ()
+        (eval '(foo? (make-me-a-record)) module)
+        #f)
+      (lambda (key rtd . _)
+        (eq? rtd (eval '<foo> module))))))
+
 (test-equal "recutils->alist"
   '((("Name" . "foo")
      ("Version" . "0.1")
diff --git a/tests/store-database.scm b/tests/store-database.scm
new file mode 100644
index 0000000000..1348a75c26
--- /dev/null
+++ b/tests/store-database.scm
@@ -0,0 +1,54 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017, 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-store-database)
+  #:use-module (guix tests)
+  #:use-module ((guix store) #:hide (register-path))
+  #:use-module (guix store database)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-64))
+
+;; Test the (guix store database) module.
+
+(define %store
+  (open-connection-for-tests))
+
+
+(test-begin "store-database")
+
+(test-assert "register-path"
+  (let ((file (string-append (%store-prefix) "/" (make-string 32 #\f)
+                             "-fake")))
+    (when (valid-path? %store file)
+      (delete-paths %store (list file)))
+    (false-if-exception (delete-file file))
+
+    (let ((ref (add-text-to-store %store "ref-of-fake" (random-text)))
+          (drv (string-append file ".drv")))
+      (call-with-output-file file
+        (cut display "This is a fake store item.\n" <>))
+      (register-path file
+                     #:references (list ref)
+                     #:deriver drv)
+
+      (and (valid-path? %store file)
+           (equal? (references %store file) (list ref))
+           (null? (valid-derivers %store file))
+           (null? (referrers %store file))))))
+
+(test-end "store-database")
diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm
new file mode 100644
index 0000000000..04817a193a
--- /dev/null
+++ b/tests/store-deduplication.scm
@@ -0,0 +1,64 @@
+;;; 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-store-deduplication)
+  #:use-module (guix tests)
+  #:use-module (guix store deduplication)
+  #:use-module (guix hash)
+  #:use-module ((guix utils) #:select (call-with-temporary-directory))
+  #:use-module (guix build utils)
+  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 binary-ports)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64))
+
+(test-begin "store-deduplication")
+
+(test-equal "deduplicate"
+  (cons* #t #f                                    ;inode comparisons
+         2 (make-list 5 6))                       ;'nlink' values
+
+  (call-with-temporary-directory
+   (lambda (store)
+     (let ((data      (string->utf8 "Hello, world!"))
+           (identical (map (lambda (n)
+                             (string-append store "/" (number->string n)))
+                           (iota 5)))
+           (unique    (string-append store "/unique")))
+       (for-each (lambda (file)
+                   (call-with-output-file file
+                     (lambda (port)
+                       (put-bytevector port data))))
+                 identical)
+       (call-with-output-file unique
+         (lambda (port)
+           (put-bytevector port (string->utf8 "This is unique."))))
+
+       (for-each (lambda (file)
+                   (deduplicate file (sha256 data) #:store store))
+                 identical)
+       (deduplicate unique (nar-sha256 unique) #:store store)
+
+       ;; (system (string-append "ls -lRia " store))
+       (cons* (apply = (map (compose stat:ino stat) identical))
+              (= (stat:ino (stat unique))
+                 (stat:ino (stat (car identical))))
+              (stat:nlink (stat unique))
+              (map (compose stat:nlink stat) identical))))))
+
+(test-end "store-deduplication")
diff --git a/tests/system.scm b/tests/system.scm
index 6a7f45c59c..7d55da7174 100644
--- a/tests/system.scm
+++ b/tests/system.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -27,8 +27,7 @@
 
 (define %root-fs
   (file-system
-    (device "my-root")
-    (title 'label)
+    (device (file-system-label "my-root"))
     (mount-point "/")
     (type "ext4")))
 
@@ -114,7 +113,6 @@
      (inherit %os-with-mapped-device)
      (file-systems (cons (file-system
                            (device "/dev/mapper/my-luks-device")
-                           (title 'device)
                            (mount-point "/")
                            (type "ext4"))
                          %base-file-systems)))))
diff --git a/tests/union.scm b/tests/union.scm
index aa95cae001..5a6a4033fc 100644
--- a/tests/union.scm
+++ b/tests/union.scm
@@ -184,4 +184,22 @@
                 (file-is-directory? "bin")
                 (eq? 'symlink (stat:type (lstat "bin/guile"))))))))
 
+(letrec-syntax ((test-relative-file-name
+                 (syntax-rules (=>)
+                   ((_ (reference file => expected) rest ...)
+                    (begin
+                      (test-equal (string-append "relative-file-name "
+                                                 reference " " file)
+                        expected
+                        (relative-file-name reference file))
+                      (test-relative-file-name rest ...)))
+                   ((_)
+                    #t))))
+  (test-relative-file-name
+   ("/a/b" "/a/c/d"     => "../c/d")
+   ("/a/b" "/a/b"       => "")
+   ("/a/b" "/a"         => "..")
+   ("/a/b" "/a/b/c/d"   => "c/d")
+   ("/a/b/c" "/a/d/e/f" => "../../d/e/f")))
+
 (test-end)
diff --git a/tests/utils.scm b/tests/utils.scm
index 035886dd16..3015b21b23 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;;
@@ -72,6 +72,12 @@
 (test-assert "guile-version>? 10.5"
   (not (guile-version>? "10.5")))
 
+(test-assert "version-prefix?"
+  (and (version-prefix? "4.1" "4.1.2")
+       (version-prefix? "4.1" "4.1")
+       (not (version-prefix? "4.1" "4.16.2"))
+       (not (version-prefix? "4.1" "4"))))
+
 (test-equal "string-tokenize*"
   '(("foo")
     ("foo" "bar" "baz")
diff --git a/tests/uuid.scm b/tests/uuid.scm
index 91a3482490..260614f079 100644
--- a/tests/uuid.scm
+++ b/tests/uuid.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -57,6 +57,13 @@
   "1234-ABCD"
   (uuid->string (uuid "1234-abcd" 'fat32)))
 
+(test-assert "uuid, dynamic value"
+  (let* ((good "4dab5feb-d176-45de-b287-9b0a6e4c01cb")
+         (bad  (string-drop good 3)))
+    (and (uuid? (uuid good))
+         (string=? good (uuid->string (uuid good)))
+         (not (uuid bad)))))
+
 (test-assert "uuid=?"
   (and (uuid=? (uuid-bytevector (uuid "1234-abcd" 'fat32))
                (uuid "1234-abcd" 'fat32))