diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/gremlin.scm | 4 | ||||
| -rw-r--r-- | tests/guix-environment.sh | 19 | ||||
| -rw-r--r-- | tests/guix-pack-localstatedir.sh | 5 | ||||
| -rw-r--r-- | tests/guix-pack-relocatable.sh | 18 | ||||
| -rw-r--r-- | tests/guix-pack.sh | 15 | ||||
| -rw-r--r-- | tests/guix-package.sh | 27 | ||||
| -rw-r--r-- | tests/lzlib.scm | 111 | ||||
| -rw-r--r-- | tests/uuid.scm | 6 |
8 files changed, 190 insertions, 15 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/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))) |