summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/base32.scm31
-rw-r--r--tests/channels.scm24
-rw-r--r--tests/guix-lint.sh13
-rw-r--r--tests/guix-pack-relocatable.sh103
-rw-r--r--tests/lint.scm2
-rw-r--r--tests/lzlib.scm120
-rw-r--r--tests/offload.scm71
-rw-r--r--tests/packages.scm23
-rw-r--r--tests/publish.scm28
-rw-r--r--tests/pypi.scm1
-rw-r--r--tests/services/linux.scm37
-rw-r--r--tests/store.scm9
-rw-r--r--tests/substitute.scm4
-rw-r--r--tests/utils.scm3
-rw-r--r--tests/zlib.scm62
15 files changed, 231 insertions, 300 deletions
diff --git a/tests/base32.scm b/tests/base32.scm
index 134e578633..a999edcacc 100644
--- a/tests/base32.scm
+++ b/tests/base32.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2015, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,26 +23,12 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-64)
- #:use-module (ice-9 rdelim)
- #:use-module (ice-9 popen)
#:use-module (ice-9 match)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports))
;; Test the (guix base32) module.
-(define %nix-hash
- (or (and=> (getenv "NIX_HASH")
- (match-lambda
- ("" #f)
- (val val)))
- "nix-hash"))
-
-(define %have-nix-hash?
- ;; Note: Use `system', not `system*', because of <http://bugs.gnu.org/13166>.
- (false-if-exception
- (zero? (system (string-append %nix-hash " --version")))))
-
(test-begin "base32")
(test-assert "bytevector->base32-string"
@@ -85,19 +71,4 @@
(nix-base32-string->bytevector
(string-append (make-string 51 #\a) "e"))))
-;; The following test requires `nix-hash' in $PATH.
-(unless %have-nix-hash?
- (test-skip 1))
-
-(test-assert "sha256 & bytevector->nix-base32-string"
- (let ((file (search-path %load-path "tests/test.drv")))
- (equal? (bytevector->nix-base32-string
- (sha256 (call-with-input-file file get-bytevector-all)))
- (let* ((c (format #f "~a --type sha256 --base32 --flat \"~a\""
- %nix-hash file))
- (p (open-input-pipe c))
- (l (read-line p)))
- (close-pipe p)
- l))))
-
(test-end)
diff --git a/tests/channels.scm b/tests/channels.scm
index cde3b668fb..1b6f640c4a 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -26,8 +26,12 @@
#:use-module (guix derivations)
#:use-module (guix sets)
#:use-module (guix gexp)
- #:use-module ((guix utils)
- #:select (error-location? error-location location-line))
+ #:use-module ((guix diagnostics)
+ #:select (error-location?
+ error-location location-line
+ formatted-message?
+ formatted-message-string
+ formatted-message-arguments))
#:use-module ((guix build utils) #:select (which))
#:use-module (git)
#:use-module (guix git)
@@ -415,8 +419,8 @@
(channel (channel (url (string-append "file://" directory))
(name 'guix))))
- (guard (c ((message-condition? c)
- (->bool (string-contains (condition-message c)
+ (guard (c ((formatted-message? c)
+ (->bool (string-contains (formatted-message-string c)
"introduction"))))
(with-store store
;; Attempt a downgrade from NEW to OLD.
@@ -459,9 +463,15 @@
(channel (channel (name 'example)
(url (string-append "file://" directory))
(introduction intro))))
- (guard (c ((message-condition? c)
- (->bool (string-contains (condition-message c)
- "initial commit"))))
+ (guard (c ((formatted-message? c)
+ (and (string-contains (formatted-message-string c)
+ "initial commit")
+ (equal? (formatted-message-arguments c)
+ (list
+ (oid->string (commit-id commit1))
+ (key-fingerprint %ed25519-public-key-file)
+ (key-fingerprint
+ %ed25519bis-public-key-file))))))
(authenticate-channel channel directory
(commit-id-string commit2)
#:keyring-reference-prefix "")
diff --git a/tests/guix-lint.sh b/tests/guix-lint.sh
index f0df1fda3a..ebe79efb84 100644
--- a/tests/guix-lint.sh
+++ b/tests/guix-lint.sh
@@ -22,8 +22,11 @@
guix lint --version
-module_dir="t-guix-lint-$$"
-mkdir "$module_dir"
+# Choose a module directory not below any %LOAD-PATH component. This is
+# necessary when testing '-L' with a relative file name.
+module_dir="$(mktemp -d)"
+
+mkdir -p "$module_dir"
trap "rm -rf $module_dir" EXIT
@@ -87,3 +90,9 @@ then false; else true; fi
# Make sure specifying multiple packages works.
guix lint -L $module_dir -c inputs-should-be-native dummy dummy@42 dummy
+
+# Test '-L' with a relative file name. 'guix lint' will see "t-xyz/foo.scm"
+# (instead of "foo.scm") and will thus fail to find it in %LOAD-PATH. Check
+# that it does find it anyway. See <https://bugs.gnu.org/42543>.
+(cd "$module_dir"/.. ; guix lint -c formatting -L "$(basename "$module_dir")" dummy@42) 2>&1 > "$module_dir/out"
+test -z "$(cat "$module_dir/out")"
diff --git a/tests/guix-pack-relocatable.sh b/tests/guix-pack-relocatable.sh
index 52d7212594..b8d36a02c6 100644
--- a/tests/guix-pack-relocatable.sh
+++ b/tests/guix-pack-relocatable.sh
@@ -38,78 +38,101 @@ then
exit 77
fi
-STORE_PARENT="`dirname $NIX_STORE_DIR`"
-export STORE_PARENT
-if test "$STORE_PARENT" = "/"; then exit 77; fi
-
-if unshare -mrf sh -c 'mount -t tmpfs none "$STORE_PARENT"'
-then
- # Test the wrapper that relies on user namespaces.
- relocatable_option="-R"
-else
- case "`uname -m`" in
- x86_64|i?86)
- # Test the wrapper that falls back to PRoot.
- relocatable_option="-RR";;
- *)
- # XXX: Our 'proot' package currently fails tests on non-Intel
- # architectures, so skip this by default.
- exit 77;;
- esac
-fi
+# Attempt to run the given command in a namespace where the store is
+# invisible. This makes sure the presence of the store does not hide
+# problems.
+run_without_store ()
+{
+ if unshare -r true # Are user namespaces supported?
+ then
+ # Run that relocatable executable 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 -o ro none "$NIX_STORE_DIR"; '"$*"
+ else
+ # Run the relocatable program in the current namespaces. This is a
+ # weak test because we're going to access store items from the host
+ # store.
+ $*
+ fi
+}
test_directory="`mktemp -d`"
export test_directory
trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
-export relocatable_option
-tarball="`guix pack $relocatable_option -S /Bin=bin sed`"
-(cd "$test_directory"; tar xvf "$tarball")
-
-if unshare -r true # Are user namespaces supported?
+if unshare -r true
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"'
+ # Test the 'userns' execution engine.
+ tarball="`guix pack -R -S /Bin=bin sed`"
+ (cd "$test_directory"; tar xvf "$tarball")
+
+ run_without_store "$test_directory/Bin/sed" --version > "$test_directory/output"
+ grep 'GNU sed' "$test_directory/output"
+
+ # Same with an explicit engine.
+ run_without_store GUIX_EXECUTION_ENGINE="userns" \
+ "$test_directory/Bin/sed" --version > "$test_directory/output"
+ grep 'GNU sed' "$test_directory/output"
# Check whether the exit code is preserved.
- if unshare -mrf sh -c 'mount -t tmpfs none "$STORE_PARENT"; echo "$STORE_PARENT"/*; "$test_directory/Bin/sed" --does-not-exist';
+ if run_without_store "$test_directory/Bin/sed" --does-not-exist;
then false; else true; fi
+
+ chmod -Rf +w "$test_directory"; rm -rf "$test_directory"/*
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"
+ echo "'userns' execution tests skipped" >&2
fi
-grep 'GNU sed' "$test_directory/output"
-chmod -Rf +w "$test_directory"; rm -rf "$test_directory"/*
case "`uname -m`" in
x86_64|i?86)
# Try '-RR' and PRoot.
tarball="`guix pack -RR -S /Bin=bin sed`"
tar tvf "$tarball" | grep /bin/proot
- (cd "$test_directory"; tar xvf "$tarball")
- GUIX_EXECUTION_ENGINE="proot"
- export GUIX_EXECUTION_ENGINE
+ (cd "$test_directory"; tar xf "$tarball")
+ run_without_store GUIX_EXECUTION_ENGINE="proot" \
"$test_directory/Bin/sed" --version > "$test_directory/output"
grep 'GNU sed' "$test_directory/output"
# Now with fakechroot.
- GUIX_EXECUTION_ENGINE="fakechroot"
+ run_without_store GUIX_EXECUTION_ENGINE="fakechroot" \
"$test_directory/Bin/sed" --version > "$test_directory/output"
grep 'GNU sed' "$test_directory/output"
chmod -Rf +w "$test_directory"; rm -rf "$test_directory"/*
+
+ if unshare -r true
+ then
+ # Check whether the store contains everything it should. Check
+ # once when erasing $STORE_PARENT ("/gnu") and once when erasing
+ # $NIX_STORE_DIR ("/gnu/store").
+ tarball="`guix pack -RR -S /bin=bin bash-minimal`"
+ (cd "$test_directory"; tar xf "$tarball")
+
+ STORE_PARENT="`dirname $NIX_STORE_DIR`"
+ export STORE_PARENT
+
+ for engine in userns proot fakechroot
+ do
+ for i in $(guix gc -R $(guix build bash-minimal | grep -v -e '-doc$'))
+ do
+ unshare -mrf sh -c "mount -t tmpfs none \"$NIX_STORE_DIR\"; GUIX_EXECUTION_ENGINE=$engine $test_directory/bin/sh -c 'echo $NIX_STORE_DIR/*'" | grep $(basename $i)
+ unshare -mrf sh -c "mount -t tmpfs none \"$STORE_PARENT\"; GUIX_EXECUTION_ENGINE=$engine $test_directory/bin/sh -c 'echo $NIX_STORE_DIR/*'" | grep $(basename $i)
+ done
+ done
+
+ chmod -Rf +w "$test_directory"; rm -rf "$test_directory"/*
+ fi
;;
*)
- echo "skipping PRoot test" >&2
+ echo "skipping PRoot and Fakechroot tests" >&2
;;
esac
# Ensure '-R' works with outputs other than "out".
tarball="`guix pack -R -S /share=share groff:doc`"
-(cd "$test_directory"; tar xvf "$tarball")
+(cd "$test_directory"; tar xf "$tarball")
test -d "$test_directory/share/doc/groff/html"
# Ensure '-R' applies to propagated inputs. Failing to do that, it would fail
diff --git a/tests/lint.scm b/tests/lint.scm
index 2f5e5623c1..95abd71378 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -334,7 +334,7 @@
(check-patch-file-names pkg))))
(test-equal "patches: not found"
- "this-patch-does-not-exist!: patch not found"
+ "this-patch-does-not-exist!: patch not found\n"
(single-lint-warning-message
(let ((pkg (dummy-package
"x"
diff --git a/tests/lzlib.scm b/tests/lzlib.scm
deleted file mode 100644
index 63d1e15641..0000000000
--- a/tests/lzlib.scm
+++ /dev/null
@@ -1,120 +0,0 @@
-;;; 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 (dictionary-size+match-length-limit %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-assert* "make-lzip-input-port/compressed"
- (let* ((len (pk 'len (+ 10 (random 4000 %seed))))
- (data (random-bytevector len))
- (compressed (make-lzip-input-port/compressed
- (open-bytevector-input-port data)))
- (result (call-with-lzip-input-port compressed
- get-bytevector-all)))
- (pk (bytevector-length result) (bytevector-length data))
- (bytevector=? result data)))
-
-(test-end)
diff --git a/tests/offload.scm b/tests/offload.scm
new file mode 100644
index 0000000000..5a5de4e8b9
--- /dev/null
+++ b/tests/offload.scm
@@ -0,0 +1,71 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;;
+;;; 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 (tests offload)
+ #:use-module (guix scripts offload)
+ #:use-module (srfi srfi-64))
+
+
+(test-begin "offload")
+
+(define-syntax-rule (expose-internal-definitions s1 s2 ...)
+ (begin
+ (define s1 (@@ (guix scripts offload) s1))
+ (define s2 (@@ (guix scripts offload) s2)) ...))
+
+(expose-internal-definitions machine-matches?
+ build-requirements-system
+ build-requirements-features
+ build-machine-system
+ build-machine-systems
+ %build-machine-system
+ %build-machine-systems
+ build-machine-features)
+
+(define (deprecated-build-machine system)
+ (build-machine
+ (name "m1")
+ (user "dummy")
+ (host-key "some-key")
+ (system system)))
+
+(define (new-build-machine systems)
+ (build-machine
+ (name "m1")
+ (user "dummy")
+ (host-key "some-key")
+ (systems systems)))
+
+;;; Test that deprecated build-machine definitions still work.
+(test-assert (machine-matches? (deprecated-build-machine "i686-linux")
+ (build-requirements
+ (system "i686-linux"))))
+
+
+(test-assert (machine-matches? (new-build-machine '("i686-linux"))
+ (build-requirements
+ (system "i686-linux"))))
+
+;;; A build machine can act as more than one system type, thanks to QEMU
+;;; emulation.
+(test-assert (machine-matches? (new-build-machine '("armhf-linux"
+ "aarch64-linux"
+ "i686-linux"
+ "x86_64-linux"))
+ (build-requirements
+ (system "armhf-linux"))))
diff --git a/tests/packages.scm b/tests/packages.scm
index 6aa36170d2..cbd0503733 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -23,7 +23,8 @@
#:use-module (guix monads)
#:use-module (guix grafts)
#:use-module ((guix gexp) #:select (local-file local-file-file))
- #:use-module ((guix utils)
+ #:use-module (guix utils)
+ #:use-module ((guix diagnostics)
;; Rename the 'location' binding to allow proper syntax
;; matching when setting the 'location' field of a package.
#:renamer (lambda (name)
@@ -617,12 +618,11 @@
(string=? (derivation->output-path drv)
(package-output %store package "out")))))
-(test-assert "patch not found yields a run-time error"
- (guard (c ((condition-has-type? c &message)
- (and (string-contains (condition-message c)
- "does-not-exist.patch")
- (string-contains (condition-message c)
- "not found"))))
+(test-equal "patch not found yields a run-time error"
+ '("~a: patch not found\n" "does-not-exist.patch")
+ (guard (c ((formatted-message? c)
+ (cons (formatted-message-string c)
+ (formatted-message-arguments c))))
(let ((p (package
(inherit (dummy-package "p"))
(source (origin
@@ -1326,6 +1326,15 @@
result))
'()))))))
+ (define (find-duplicates l)
+ (match l
+ (() '())
+ ((head . tail)
+ (if (member head tail)
+ (cons head (find-duplicates tail))
+ (find-duplicates tail)))))
+
+ (pk (find-duplicates from-cache))
(and (equal? (delete-duplicates from-cache) from-cache)
(lset= equal? no-cache from-cache))))
diff --git a/tests/publish.scm b/tests/publish.scm
index e43310ef00..1c3b2785fb 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -35,8 +35,8 @@
#:use-module ((guix serialization) #:select (restore-file))
#:use-module (gcrypt pk-crypto)
#:use-module ((guix pki) #:select (%public-key-file %private-key-file))
- #:use-module (guix zlib)
- #:use-module (guix lzlib)
+ #:use-module (zlib)
+ #:use-module (lzlib)
#:use-module (web uri)
#:use-module (web client)
#:use-module (web response)
@@ -204,8 +204,6 @@ References: ~%"
(call-with-input-string nar (cut restore-file <> temp)))
(call-with-input-file temp read-string))))
-(unless (zlib-available?)
- (test-skip 1))
(test-equal "/nar/gzip/*"
"bar"
(call-with-temporary-output-file
@@ -217,8 +215,6 @@ References: ~%"
(cut restore-file <> temp)))
(call-with-input-file temp read-string))))
-(unless (zlib-available?)
- (test-skip 1))
(test-equal "/nar/gzip/* is really gzip"
%gzip-magic-bytes
;; Since 'gzdopen' (aka. 'call-with-gzip-input-port') transparently reads
@@ -229,8 +225,6 @@ References: ~%"
(string-append "/nar/gzip/" (basename %item))))))
(get-bytevector-n nar (bytevector-length %gzip-magic-bytes))))
-(unless (lzlib-available?)
- (test-skip 1))
(test-equal "/nar/lzip/*"
"bar"
(call-with-temporary-output-file
@@ -242,8 +236,6 @@ References: ~%"
(cut restore-file <> temp)))
(call-with-input-file temp read-string))))
-(unless (zlib-available?)
- (test-skip 1))
(test-equal "/*.narinfo with compression"
`(("StorePath" . ,%item)
("URL" . ,(string-append "nar/gzip/" (basename %item)))
@@ -264,8 +256,6 @@ References: ~%"
(_ #f)))
(recutils->alist body)))))
-(unless (lzlib-available?)
- (test-skip 1))
(test-equal "/*.narinfo with lzip compression"
`(("StorePath" . ,%item)
("URL" . ,(string-append "nar/lzip/" (basename %item)))
@@ -286,8 +276,6 @@ References: ~%"
(_ #f)))
(recutils->alist body)))))
-(unless (zlib-available?)
- (test-skip 1))
(test-equal "/*.narinfo for a compressed file"
'("none" "nar") ;compression-less nar
;; Assume 'guix publish -C' is already running on port 6799.
@@ -300,8 +288,6 @@ References: ~%"
(list (assoc-ref info "Compression")
(dirname (assoc-ref info "URL")))))
-(unless (and (zlib-available?) (lzlib-available?))
- (test-skip 1))
(test-equal "/*.narinfo with lzip + gzip"
`((("StorePath" . ,%item)
("URL" . ,(string-append "nar/gzip/" (basename %item)))
@@ -411,8 +397,6 @@ References: ~%"
(call-with-input-string "" port-sha256))))))
(response-code (http-get uri))))
-(unless (zlib-available?)
- (test-skip 1))
(test-equal "with cache"
(list #t
`(("StorePath" . ,%item)
@@ -469,8 +453,6 @@ References: ~%"
(stat:size (stat nar)))
(response-code uncompressed)))))))))
-(unless (and (zlib-available?) (lzlib-available?))
- (test-skip 1))
(test-equal "with cache, lzip + gzip"
'(200 200 404)
(call-with-temporary-directory
@@ -515,8 +497,6 @@ References: ~%"
(response-code
(http-get uncompressed))))))))))
-(unless (zlib-available?)
- (test-skip 1))
(let ((item (add-text-to-store %store "fake-compressed-thing.tar.gz"
(random-text))))
(test-equal "with cache, uncompressed"
@@ -596,9 +576,7 @@ References: ~%"
(item (add-text-to-store %store "random" (random-text)))
(part (store-path-hash-part item))
(url (string-append base part ".narinfo"))
- (cached (string-append cache
- (if (zlib-available?)
- "/gzip/" "/none/")
+ (cached (string-append cache "/gzip/"
(basename item)
".narinfo"))
(response (http-get url)))
diff --git a/tests/pypi.scm b/tests/pypi.scm
index 6788c8db3e..f421d6d9df 100644
--- a/tests/pypi.scm
+++ b/tests/pypi.scm
@@ -23,7 +23,6 @@
#:use-module (guix base32)
#:use-module (guix memoization)
#:use-module (gcrypt hash)
- #:use-module (guix memoization)
#:use-module (guix tests)
#:use-module (guix build-system python)
#:use-module ((guix build utils) #:select (delete-file-recursively which mkdir-p))
diff --git a/tests/services/linux.scm b/tests/services/linux.scm
index 8ad119c49f..e2cd191e48 100644
--- a/tests/services/linux.scm
+++ b/tests/services/linux.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -54,4 +55,40 @@
"-N" "python \"/some/path/notify-all-users.py\"")
(earlyoom-configuration->command-line-args %earlyoom-configuration-sample))
+
+;;;
+;;; Zram swap device.
+;;;
+
+(define zram-device-configuration->udev-string
+ (@@ (gnu services linux) zram-device-configuration->udev-string))
+
+(define %zram-swap-device-test-1
+ (zram-device-configuration
+ (size "2G")
+ (compression-algorithm 'zstd)
+ (memory-limit "1G")
+ (priority 42)))
+
+(test-equal "zram-swap-device-test-1"
+ "KERNEL==\"zram0\", ATTR{comp_algorithm}=\"zstd\" ATTR{disksize}=\"2G\" ATTR{mem_limit}=\"1G\" RUN+=\"/run/current-system/profile/sbin/mkswap /dev/zram0\" RUN+=\"/run/current-system/profile/sbin/swapon --priority 42 /dev/zram0\"\n"
+ (zram-device-configuration->udev-string %zram-swap-device-test-1))
+
+(define %zram-swap-device-test-2
+ (zram-device-configuration
+ (size 1048576) ; 1M
+ (compression-algorithm 'lz4)))
+
+(test-equal "zram-swap-device-test-2"
+ "KERNEL==\"zram0\", ATTR{comp_algorithm}=\"lz4\" ATTR{disksize}=\"1048576\" RUN+=\"/run/current-system/profile/sbin/mkswap /dev/zram0\" RUN+=\"/run/current-system/profile/sbin/swapon /dev/zram0\"\n"
+ (zram-device-configuration->udev-string %zram-swap-device-test-2))
+
+(define %zram-swap-device-test-3
+ (zram-device-configuration
+ (memory-limit (* 512 1000))))
+
+(test-equal "zram-swap-device-test-3"
+ "KERNEL==\"zram0\", ATTR{comp_algorithm}=\"lzo\" ATTR{disksize}=\"1G\" ATTR{mem_limit}=\"512000\" RUN+=\"/run/current-system/profile/sbin/mkswap /dev/zram0\" RUN+=\"/run/current-system/profile/sbin/swapon /dev/zram0\"\n"
+ (zram-device-configuration->udev-string %zram-swap-device-test-3))
+
(test-end "linux-services")
diff --git a/tests/store.scm b/tests/store.scm
index ee3e01f33b..e168d3dcf6 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -141,6 +141,15 @@
(string-append (%store-prefix) "/"
(make-string 32 #\e) "-foobar"))))
+(test-equal "with-store, multiple values" ;<https://bugs.gnu.org/42912>
+ '(1 2 3)
+ (call-with-values
+ (lambda ()
+ (with-store s
+ (add-text-to-store s "foo" "bar")
+ (values 1 2 3)))
+ list))
+
(test-assert "valid-path? error"
(with-store s
(guard (c ((store-protocol-error? c) #t))
diff --git a/tests/substitute.scm b/tests/substitute.scm
index a4246aff82..6560612c40 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -29,7 +29,6 @@
#:use-module ((guix store) #:select (%store-prefix))
#:use-module ((guix ui) #:select (guix-warning-port))
#:use-module ((guix utils) #:select (call-with-compressed-output-port))
- #:use-module ((guix lzlib) #:select (lzlib-available?))
#:use-module ((guix build utils)
#:select (mkdir-p delete-file-recursively dump-port))
#:use-module (guix tests http)
@@ -508,8 +507,7 @@ System: mips64el-linux\n")))
(let ((nar (string-append %main-substitute-directory
"/example.nar")))
(compress nar (string-append nar ".gz") 'gzip)
- (when (lzlib-available?)
- (compress nar (string-append nar ".lz") 'lzip)))
+ (compress nar (string-append nar ".lz") 'lzip))
(parameterize ((substitute-urls
(list (string-append "file://"
diff --git a/tests/utils.scm b/tests/utils.scm
index f78ec356bd..009e2121ab 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -23,7 +23,6 @@
#:use-module (guix utils)
#:use-module ((guix store) #:select (%store-prefix store-path-package-name))
#:use-module ((guix search-paths) #:select (string-tokenize*))
- #:use-module ((guix lzlib) #:select (lzlib-available?))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-64)
@@ -215,7 +214,7 @@ skip these tests."
(for-each test-compression/decompression
'(gzip xz lzip)
- (list (const #t) (const #t) lzlib-available?))
+ (list (const #t) (const #t) (const #t)))
;; This is actually in (guix store).
(test-equal "store-path-package-name"
diff --git a/tests/zlib.scm b/tests/zlib.scm
deleted file mode 100644
index 7c595a422c..0000000000
--- a/tests/zlib.scm
+++ /dev/null
@@ -1,62 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2019 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-zlib)
- #:use-module (guix zlib)
- #: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 zlib) module.
-
-(test-begin "zlib")
-
-(unless (zlib-available?)
- (test-skip 1))
-(test-assert "compression/decompression pipe"
- (let ((data (random-bytevector (+ (random 10000)
- (* 20 1024)))))
- (match (pipe)
- ((parent . child)
- (match (primitive-fork)
- (0 ;compress
- (dynamic-wind
- (const #t)
- (lambda ()
- (close-port parent)
- (call-with-gzip-output-port child
- (lambda (port)
- (put-bytevector port data))))
- (lambda ()
- (primitive-exit 0))))
- (pid ;decompress
- (begin
- (close-port child)
- (let ((received (call-with-gzip-input-port parent
- (lambda (port)
- (get-bytevector-all port))
- #:buffer-size (* 64 1024))))
- (match (waitpid pid)
- ((_ . status)
- (and (zero? status)
- (port-closed? parent)
- (bytevector=? received data))))))))))))
-
-(test-end)
generated by cgit v1.2.3 (git 2.45.2) at 2024-07-15 11:32:28 +0000