summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2019-05-25 00:25:15 +0200
committerMarius Bakke <mbakke@fastmail.com>2019-05-25 00:25:15 +0200
commit57df83e07d4b5e78d9a54c1a88d05b4a9ed65714 (patch)
tree76684e63965e9ad6e37d9d45bc3159e6c9782cd0 /tests
parent43d9ed7792808638eabb43aa6133f1d6186c520b (diff)
parent136b7d81f0eb713783e9ea7cf7f260a2b6252dfd (diff)
Merge branch 'staging' into core-updates
Diffstat (limited to 'tests')
-rw-r--r--tests/gremlin.scm4
-rw-r--r--tests/guix-environment.sh19
-rw-r--r--tests/guix-pack-localstatedir.sh5
-rw-r--r--tests/guix-pack-relocatable.sh18
-rw-r--r--tests/guix-pack.sh15
-rw-r--r--tests/guix-package.sh27
-rw-r--r--tests/guix-system.sh4
-rw-r--r--tests/lzlib.scm111
-rw-r--r--tests/uuid.scm6
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)))