Merge branch 'staging' into core-updates

9 files changed, 192 insertions, 17 deletions

diff --git a/tests/gremlin.scm b/tests/gremlin.scm
index 77a5dc1998..b0bb7a8e49 100644
--- a/tests/gremlin.scm
+++ b/tests/gremlin.scm
@@ -52,7 +52,7 @@
     (or (not dyninfo)                             ;static executable
         (lset<= string=?
                 (list (string-append "libguile-" (effective-version))
-                      "libgc" "libunistring" "libffi")
+                      "libc")
                 (map (lambda (lib)
                        (string-take lib (string-contains lib ".so")))
                      (elf-dynamic-info-needed dyninfo))))))
@@ -79,7 +79,7 @@
          (lambda (port)
            (display "int main () { puts(\"hello\"); }" port)))
        (invoke c-compiler "t.c"
-               "-Wl,-rpath=/foo" "-Wl,-rpath=/bar")
+               "-Wl,--enable-new-dtags" "-Wl,-rpath=/foo" "-Wl,-rpath=/bar")
        (let* ((dyninfo (elf-dynamic-info
                         (parse-elf (call-with-input-file "a.out"
                                      get-bytevector-all))))
diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh
index 7ea9c200de..a670db36be 100644
--- a/tests/guix-environment.sh
+++ b/tests/guix-environment.sh
@@ -133,6 +133,25 @@ case "$transformed_drv" in
 esac
 rmdir "$tmpdir/emacs-36.8"
 
+# Transformation options without '--ad-hoc'.
+drv="`guix environment -n emacs-geiser 2>&1 | grep '\.drv$'`"
+transformed_drv="`guix environment -n emacs-geiser \
+  --with-input=emacs-minimal=vim 2>&1 | grep '\.drv$'`"
+test "$drv" != "$transformed_drv"
+case "$drv" in
+    *-emacs-minimal*.drv*) true;;
+    *)                     false;;
+esac
+case "$transformed_drv" in
+    *-emacs-minimal*.drv*) false;;
+    *)                     true;;
+esac
+case "$transformed_drv" in
+    *-vim*.drv*) true;;
+    *)           false;;
+esac
+
+
 if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
 then
     # Compute the build environment for the initial GNU Make.
diff --git a/tests/guix-pack-localstatedir.sh b/tests/guix-pack-localstatedir.sh
index b734b0f7e3..042887ea9b 100644
--- a/tests/guix-pack-localstatedir.sh
+++ b/tests/guix-pack-localstatedir.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -27,8 +27,9 @@ guix pack --version
 # 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)'`"
+storedir="`guile -c '(use-modules (guix config))(display %storedir)'`"
 localstatedir="`guile -c '(use-modules (guix config))(display %localstatedir)'`"
+NIX_STORE_DIR="$storedir"
 GUIX_DAEMON_SOCKET="$localstatedir/guix/daemon-socket/socket"
 export NIX_STORE_DIR GUIX_DAEMON_SOCKET
 
diff --git a/tests/guix-pack-relocatable.sh b/tests/guix-pack-relocatable.sh
index 38dcf1e485..ebada62c01 100644
--- a/tests/guix-pack-relocatable.sh
+++ b/tests/guix-pack-relocatable.sh
@@ -27,8 +27,9 @@ guix pack --version
 # 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)'`"
+storedir="`guile -c '(use-modules (guix config))(display %storedir)'`"
 localstatedir="`guile -c '(use-modules (guix config))(display %localstatedir)'`"
+NIX_STORE_DIR="$storedir"
 GUIX_DAEMON_SOCKET="$localstatedir/guix/daemon-socket/socket"
 export NIX_STORE_DIR GUIX_DAEMON_SOCKET
 
@@ -65,8 +66,15 @@ export relocatable_option
 tarball="`guix pack $relocatable_option -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"'
+if unshare -r true		# Are user namespaces supported?
+then
+    # 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"'
+else
+    # Run the relocatable 'sed' in the current namespaces.  This is a weak
+    # test because we're going to access store items from the host store.
+    "$test_directory/Bin/sed" --version > "$test_directory/output"
+fi
 grep 'GNU sed' "$test_directory/output"
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index a43f4d128f..0feae6d1e8 100644
--- a/tests/guix-pack.sh
+++ b/tests/guix-pack.sh
@@ -1,6 +1,6 @@
 # GNU Guix --- Functional package management for GNU
 # Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
-# Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -33,6 +33,9 @@ guix pack --version
 GUIX_BUILD_OPTIONS="--no-substitutes"
 export GUIX_BUILD_OPTIONS
 
+test_directory="`mktemp -d`"
+trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
+
 # Build a tarball with no compression.
 guix pack --compression=none --bootstrap guile-bootstrap
 
@@ -42,14 +45,18 @@ out2="`guix pack --bootstrap -e '(@ (gnu packages bootstrap) %bootstrap-guile)'`
 test -n "$out1"
 test "$out1" = "$out2"
 
+# Test '--root'.
+guix pack -r "$test_directory/my-guile" --bootstrap guile-bootstrap
+test "`readlink "$test_directory/my-guile"`" = "$out1"
+guix gc --list-roots | grep "^$test_directory/my-guile$"
+rm "$test_directory/my-guile"
+
 # Build a tarball with a symlink.
 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 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
 cd "$test_directory"
 tar -xf "$the_pack"
 test -L opt/gnu/bin
@@ -59,7 +66,7 @@ is_available () {
     type "$1" > /dev/null
 }
 
-if is_available chroot && is_available unshare; then
+if is_available chroot && is_available unshare && unshare -r true; then
     # Verify we can use what we built.
     unshare -r chroot . /opt/gnu/bin/guile --version
     cd -
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index 0d60481895..767c3f8a66 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -85,7 +85,7 @@ then false; else true; fi
 guix package -p "$profile" --delete-generations=0
 
 # Make sure multiple arguments to -i works.
-guix package --bootstrap -i guile gcc -p "$profile" -n
+guix package --bootstrap -i guile zile -p "$profile" -n
 
 # Make sure the `:' syntax works.
 guix package --bootstrap -i "glibc:debug" -p "$profile" -n
@@ -398,3 +398,28 @@ else
     grep "manifest.scm:[1-3]:.*wonderful-package.*: unbound variable" \
 	 "$module_dir/stderr"
 fi
+
+# Verify that package outputs are included in search results.
+rm -rf "$module_dir"
+mkdir "$module_dir"
+cat > "$module_dir/foo.scm"<<EOF
+(define-module (foo)
+  #:use-module (guix packages)
+  #:use-module (guix build-system trivial))
+
+(define-public dummy-package
+  (package
+    (name "dummy-package")
+    (version "dummy-version")
+    (outputs '("out" "dummy-output"))
+    (source #f)
+    ;; Without a real build system, the "guix pacakge -s" command will fail.
+    (build-system trivial-build-system)
+    (synopsis "dummy-synopsis")
+    (description "dummy-description")
+    (home-page "https://dummy-home-page")
+    (license #f)))
+EOF
+guix package -L "$module_dir" -s dummy-output > /tmp/out
+test "`guix package -L "$module_dir" -s dummy-output | grep ^name:`" = "name: dummy-package"
+rm -rf "$module_dir"
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index 9903677a02..1b2c425725 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -281,8 +281,8 @@ guix system search anonym network | grep "^name: tor"
 # build these images, the commands would take hours to run in the worst case.
 
 # Verify that the examples can be built.
-for example in gnu/system/examples/*; do
-    guix system -n disk-image $example
+for example in gnu/system/examples/*.tmpl; do
+    guix system -n disk-image "$example"
 done
 
 # Verify that the disk image types can be built.
diff --git a/tests/lzlib.scm b/tests/lzlib.scm
new file mode 100644
index 0000000000..cf53a9417d
--- /dev/null
+++ b/tests/lzlib.scm
@@ -0,0 +1,111 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz>
+;;;
+;;; 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-lzlib)
+  #:use-module (guix lzlib)
+  #:use-module (guix tests)
+  #:use-module (srfi srfi-64)
+  #:use-module (rnrs bytevectors)
+  #:use-module (rnrs io ports)
+  #:use-module (ice-9 match))
+
+;; Test the (guix lzlib) module.
+
+(define-syntax-rule (test-assert* description exp)
+  (begin
+    (unless (lzlib-available?)
+      (test-skip 1))
+    (test-assert description exp)))
+
+(test-begin "lzlib")
+
+(define (compress-and-decompress data)
+  "DATA must be a bytevector."
+  (pk "Uncompressed bytes:" (bytevector-length data))
+  (match (pipe)
+    ((parent . child)
+     (match (primitive-fork)
+       (0                               ;compress
+        (dynamic-wind
+          (const #t)
+          (lambda ()
+            (close-port parent)
+            (call-with-lzip-output-port child
+              (lambda (port)
+                (put-bytevector port data))))
+          (lambda ()
+            (primitive-exit 0))))
+       (pid                             ;decompress
+        (begin
+          (close-port child)
+          (let ((received (call-with-lzip-input-port parent
+                            (lambda (port)
+                              (get-bytevector-all port)))))
+            (match (waitpid pid)
+              ((_ . status)
+               (pk "Status" status)
+               (pk "Length data" (bytevector-length data) "received" (bytevector-length received))
+               ;; The following loop is a debug helper.
+               (let loop ((i 0))
+                 (if (and (< i (bytevector-length received))
+                          (= (bytevector-u8-ref received i)
+                             (bytevector-u8-ref data i)))
+                     (loop (+ 1 i))
+                     (pk "First diff at index" i)))
+               (and (zero? status)
+                    (port-closed? parent)
+                    (bytevector=? received data)))))))))))
+
+(test-assert* "null bytevector"
+  (compress-and-decompress (make-bytevector (+ (random 100000)
+                                               (* 20 1024)))))
+
+(test-assert* "random bytevector"
+  (compress-and-decompress (random-bytevector (+ (random 100000)
+                                                 (* 20 1024)))))
+(test-assert* "small bytevector"
+  (compress-and-decompress (random-bytevector 127)))
+
+(test-assert* "1 bytevector"
+  (compress-and-decompress (random-bytevector 1)))
+
+(test-assert* "Bytevector of size relative to Lzip internal buffers (2 * dictionary)"
+  (compress-and-decompress
+   (random-bytevector
+    (* 2 (car (car (assoc-ref (@@ (guix lzlib) %compression-levels)
+                              (@@ (guix lzlib) %default-compression-level))))))))
+
+(test-assert* "Bytevector of size relative to Lzip internal buffers (64KiB)"
+  (compress-and-decompress (random-bytevector (* 64 1024))))
+
+(test-assert* "Bytevector of size relative to Lzip internal buffers (64KiB-1)"
+  (compress-and-decompress (random-bytevector (1- (* 64 1024)))))
+
+(test-assert* "Bytevector of size relative to Lzip internal buffers (64KiB+1)"
+  (compress-and-decompress (random-bytevector (1+ (* 64 1024)))))
+
+(test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB)"
+  (compress-and-decompress (random-bytevector (* 1024 1024))))
+
+(test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB-1)"
+  (compress-and-decompress (random-bytevector (1- (* 1024 1024)))))
+
+(test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB+1)"
+  (compress-and-decompress (random-bytevector (1+ (* 1024 1024)))))
+
+(test-end)
diff --git a/tests/uuid.scm b/tests/uuid.scm
index 260614f079..1c6d1e9e57 100644
--- a/tests/uuid.scm
+++ b/tests/uuid.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -57,6 +57,10 @@
   "1234-ABCD"
   (uuid->string (uuid "1234-abcd" 'fat32)))
 
+(test-equal "uuid, FAT32, leading zeros preserved"
+  "00CA-050E"                                    ;<https://bugs.gnu.org/35582>
+  (uuid->string (uuid "00CA-050E" 'fat32)))
+
 (test-assert "uuid, dynamic value"
   (let* ((good "4dab5feb-d176-45de-b287-9b0a6e4c01cb")
          (bad  (string-drop good 3)))