summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/containers.scm8
-rw-r--r--tests/guix-archive.sh9
-rw-r--r--tests/guix-authenticate.sh52
-rw-r--r--tests/guix-build-branch.sh3
-rw-r--r--tests/guix-build.sh33
-rw-r--r--tests/guix-daemon.sh2
-rw-r--r--tests/guix-download.sh12
-rw-r--r--tests/guix-environment-container.sh25
-rw-r--r--tests/guix-environment.sh8
-rw-r--r--tests/guix-gc.sh13
-rw-r--r--tests/guix-git-authenticate.sh5
-rw-r--r--tests/guix-graph.sh7
-rw-r--r--tests/guix-hash.sh12
-rw-r--r--tests/guix-lint.sh18
-rw-r--r--tests/guix-pack-relocatable.sh3
-rw-r--r--tests/guix-pack.sh3
-rw-r--r--tests/guix-package-aliases.sh20
-rw-r--r--tests/guix-package-net.sh9
-rw-r--r--tests/guix-package.sh66
-rw-r--r--tests/guix-repl.sh4
-rw-r--r--tests/guix-system.sh23
-rw-r--r--tests/opam.scm139
-rw-r--r--tests/openpgp.scm12
-rw-r--r--tests/packages.scm172
-rw-r--r--tests/scripts-build.scm26
-rw-r--r--tests/store.scm44
26 files changed, 476 insertions, 252 deletions
diff --git a/tests/containers.scm b/tests/containers.scm
index 7b63e5c108..608902c41a 100644
--- a/tests/containers.scm
+++ b/tests/containers.scm
@@ -134,6 +134,14 @@
(primitive-exit 0)))))
(skip-if-unsupported)
+(test-assert "call-with-container, mnt namespace, root permissions"
+ (zero?
+ (call-with-container '()
+ (lambda ()
+ (assert-exit (= #o755 (stat:perms (lstat "/")))))
+ #:namespaces '(user mnt))))
+
+(skip-if-unsupported)
(test-assert "container-excursion"
(call-with-temporary-directory
(lambda (root)
diff --git a/tests/guix-archive.sh b/tests/guix-archive.sh
index 4c5eea05cf..e796c62f9a 100644
--- a/tests/guix-archive.sh
+++ b/tests/guix-archive.sh
@@ -44,8 +44,7 @@ cmp "$archive" "$archive_alt"
# Check the exit value upon import.
guix archive --import < "$archive"
-if guix archive something-that-does-not-exist
-then false; else true; fi
+! guix archive something-that-does-not-exist
# This one must not be listed as missing.
guix build guile-bootstrap > "$archive"
@@ -62,8 +61,7 @@ cmp "$archive" "$archive_alt"
# This is not a valid store file name, so an error.
echo something invalid > "$archive"
-if guix archive --missing < "$archive"
-then false; else true; fi
+! guix archive --missing < "$archive"
# Check '--extract'.
guile -c "(use-modules (guix serialization))
@@ -79,5 +77,4 @@ guix archive -t < "$archive" | grep "^D /share/guile"
guix archive -t < "$archive" | grep "^x /bin/guile"
guix archive -t < "$archive" | grep "^r /share/guile.*/boot-9\.scm"
-if echo foo | guix archive --authorize
-then false; else true; fi
+! echo foo | guix archive --authorize
diff --git a/tests/guix-authenticate.sh b/tests/guix-authenticate.sh
index 773443453d..3a05b232c1 100644
--- a/tests/guix-authenticate.sh
+++ b/tests/guix-authenticate.sh
@@ -28,33 +28,47 @@ rm -f "$sig" "$hash"
trap 'rm -f "$sig" "$hash"' EXIT
+key="$abs_top_srcdir/tests/signing-key.sec"
+key_len="`echo -n $key | wc -c`"
+
# A hexadecimal string as long as a sha256 hash.
hash="2749f0ea9f26c6c7be746a9cff8fa4c2f2a02b000070dba78429e9a11f87c6eb"
+hash_len="`echo -n $hash | wc -c`"
-guix authenticate sign \
- "$abs_top_srcdir/tests/signing-key.sec" \
- "$hash" > "$sig"
+echo "sign $key_len:$key $hash_len:$hash" | guix authenticate > "$sig"
test -f "$sig"
+case "$(cat $sig)" in
+ "0 "*) ;;
+ *) echo "broken signature: $(cat $sig)"
+ exit 42;;
+esac
+
+# Remove the leading "0".
+sed -i "$sig" -e's/^0 //g'
-hash2="`guix authenticate verify "$sig"`"
-test "$hash2" = "$hash"
+hash2="$(echo verify $(cat "$sig") | guix authenticate)"
+test "$(echo $hash2 | cut -d : -f 2)" = "$hash"
# Detect corrupt signatures.
-if guix authenticate verify /dev/null
-then false
-else true
-fi
+code="$(echo "verify 5:wrong" | guix authenticate | cut -f1 -d ' ')"
+test "$code" -ne 0
# Detect invalid signatures.
# The signature has (payload (data ... (hash sha256 #...#))). We proceed by
# modifying this hash.
sed -i "$sig" \
-e's|#[A-Z0-9]\{64\}#|#0000000000000000000000000000000000000000000000000000000000000000#|g'
-if guix authenticate verify "$sig"
-then false
-else true
-fi
+code="$(echo "verify $(cat $sig)" | guix authenticate | cut -f1 -d ' ')"
+test "$code" -ne 0
+# Make sure byte strings are correctly encoded. The hash string below is
+# "café" repeated 8 times. Libgcrypt would normally choose to write it as a
+# string rather than a hex sequence. We want that string to be Latin-1
+# encoded independently of the current locale: <https://bugs.gnu.org/43421>.
+hash="636166e9636166e9636166e9636166e9636166e9636166e9636166e9636166e9"
+latin1_cafe="caf$(printf '\351')"
+echo "sign 21:tests/signing-key.sec 64:$hash" | guix authenticate \
+ | LC_ALL=C grep "hash sha256 \"$latin1_cafe"
# Test for <http://bugs.gnu.org/17312>: make sure 'guix authenticate' produces
# valid signatures when run in the C locale.
@@ -63,9 +77,11 @@ hash="5eff0b55c9c5f5e87b4e34cd60a2d5654ca1eb78c7b3c67c3179fed1cff07b4c"
LC_ALL=C
export LC_ALL
-guix authenticate sign "$abs_top_srcdir/tests/signing-key.sec" "$hash" \
- > "$sig"
+echo "sign $key_len:$key $hash_len:$hash" | guix authenticate > "$sig"
+
+# Remove the leading "0".
+sed -i "$sig" -e's/^0 //g'
-guix authenticate verify "$sig"
-hash2="`guix authenticate verify "$sig"`"
-test "$hash2" = "$hash"
+echo "verify $(cat $sig)" | guix authenticate
+hash2="$(echo "verify $(cat $sig)" | guix authenticate | cut -f2 -d ' ')"
+test "$(echo $hash2 | cut -d : -f 2)" = "$hash"
diff --git a/tests/guix-build-branch.sh b/tests/guix-build-branch.sh
index c5b07e07c6..79aa06a58f 100644
--- a/tests/guix-build-branch.sh
+++ b/tests/guix-build-branch.sh
@@ -58,5 +58,4 @@ guix gc -R "$v0_1_0_drv" | grep guile-gcrypt-8fe64e8 # this is the tag ID
test "$v0_1_0_drv" != "$latest_drv"
test "$v0_1_0_drv" != "$orig_drv"
-if guix build guix --with-commit=guile-gcrypt=000 -d
-then false; else true; fi
+! guix build guix --with-commit=guile-gcrypt=000 -d
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index 6c08857358..6dbb53206e 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -24,8 +24,7 @@
guix build --version
# Should fail.
-if guix build -e +;
-then false; else true; fi
+! guix build -e +
# Source-less packages are accepted; they just return nothing.
guix build -e '(@ (gnu packages bootstrap) %bootstrap-glibc)' -S
@@ -178,7 +177,7 @@ cat > "$module_dir/foo.scm" <<EOF
(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
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
@@ -222,7 +221,7 @@ test "`guix build --log-file guile-bootstrap`" = "$log"
test "`guix build --log-file $out`" = "$log"
# Should fail because the name/version combination could not be found.
-if guix build hello-0.0.1 -n; then false; else true; fi
+! guix build hello-0.0.1 -n
# Keep a symlink to the result, registered as a root.
result="t-result-$$"
@@ -231,8 +230,7 @@ guix build -r "$result" \
test -x "$result/bin/guile"
# Should fail, because $result already exists.
-if guix build -r "$result" -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'
-then false; else true; fi
+! guix build -r "$result" -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'
rm -f "$result"
@@ -259,8 +257,18 @@ drv1=`guix build guile -d`
drv2=`guix build guile --with-input=gimp=ruby -d`
test "$drv1" = "$drv2"
-if guix build guile --with-input=libunistring=something-really-silly
-then false; else true; fi
+# See <https://bugs.gnu.org/42156>.
+drv1=`guix build glib -d`
+drv2=`guix build glib -d --with-input=libreoffice=inkscape`
+test "$drv1" = "$drv2"
+
+# Rewriting implicit inputs.
+drv1=`guix build hello -d`
+drv2=`guix build hello -d --with-input=gcc=gcc-toolchain`
+test "$drv1" != "$drv2"
+guix gc -R "$drv2" | grep `guix build -d gcc-toolchain`
+
+! guix build guile --with-input=libunistring=something-really-silly
# Deprecated/superseded packages.
test "`guix build superseded -d`" = "`guix build bar -d`"
@@ -268,10 +276,8 @@ test "`guix build superseded -d`" = "`guix build bar -d`"
# Parsing package names and versions.
guix build -n time # PASS
guix build -n time@1.9 # PASS, version found
-if guix build -n time@3.2; # FAIL, version not found
-then false; else true; fi
-if guix build -n something-that-will-never-exist; # FAIL
-then false; else true; fi
+! guix build -n time@3.2 # FAIL, version not found
+! guix build -n something-that-will-never-exist # FAIL
# Invoking a monadic procedure.
guix build -e "(begin
@@ -343,5 +349,4 @@ export GUIX_BUILD_OPTIONS
guix build emacs
GUIX_BUILD_OPTIONS="--something-completely-crazy"
-if guix build emacs;
-then false; else true; fi
+! guix build emacs
diff --git a/tests/guix-daemon.sh b/tests/guix-daemon.sh
index b58500966b..330ad68835 100644
--- a/tests/guix-daemon.sh
+++ b/tests/guix-daemon.sh
@@ -224,7 +224,7 @@ daemon_pid=$!
GUIX_DAEMON_SOCKET="guix://$tcp_socket"
export GUIX_DAEMON_SOCKET
-if guix gc; then false; else true; fi
+! guix gc
unset GUIX_DAEMON_SOCKET
kill "$daemon_pid"
diff --git a/tests/guix-download.sh b/tests/guix-download.sh
index 30f55fbe2b..5475d43e60 100644
--- a/tests/guix-download.sh
+++ b/tests/guix-download.sh
@@ -23,14 +23,11 @@
guix download --version
# Make sure it fails here.
-if guix download http://does.not/exist
-then false; else true; fi
+! guix download http://does.not/exist
-if guix download unknown://some/where;
-then false; else true; fi
+! guix download unknown://some/where;
-if guix download /does-not-exist
-then false; else true; fi
+! guix download /does-not-exist
# This one should succeed.
guix download "file://$abs_top_srcdir/README"
@@ -46,5 +43,4 @@ GUIX_DAEMON_SOCKET="/nowhere" guix download -o "$output" \
cmp "$output" "$abs_top_srcdir/README"
# This one should fail.
-if guix download "file:///does-not-exist" "file://$abs_top_srcdir/README"
-then false; else true; fi
+! guix download "file:///does-not-exist" "file://$abs_top_srcdir/README"
diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh
index 45264d4978..f2d15c8d0c 100644
--- a/tests/guix-environment-container.sh
+++ b/tests/guix-environment-container.sh
@@ -44,6 +44,21 @@ else
test $? = 42
fi
+# Make sure "localhost" resolves.
+guix environment --container --ad-hoc --bootstrap guile-bootstrap \
+ -- guile -c '(exit (pair? (getaddrinfo "localhost" "80")))'
+
+# We should get ECONNREFUSED, not ENETUNREACH, which would indicate that "lo"
+# is down.
+guix environment --container --ad-hoc --bootstrap guile-bootstrap \
+ -- guile -c "(exit (= ECONNREFUSED
+ (catch 'system-error
+ (lambda ()
+ (let ((sock (socket AF_INET SOCK_STREAM 0)))
+ (connect sock AF_INET INADDR_LOOPBACK 12345)))
+ (lambda args
+ (pk 'errno (system-error-errno args))))))"
+
# Make sure '--preserve' is honored.
result="`FOOBAR=42; export FOOBAR; guix environment -C --ad-hoc --bootstrap \
guile-bootstrap -E ^FOO -- guile -c '(display (getenv \"FOOBAR\"))'`"
@@ -127,11 +142,15 @@ grep -e "$NIX_STORE_DIR/.*-bash" $tmpdir/mounts # bootstrap bash
rm $tmpdir/mounts
-# Make sure 'GUIX_ENVIRONMENT' is linked to '~/.guix-profile' when requested
+# Make sure 'GUIX_ENVIRONMENT' is set to '~/.guix-profile' when requested
# within a container.
(
- linktest='(exit (string=? (getenv "GUIX_ENVIRONMENT")
-(readlink (string-append (getenv "HOME") "/.guix-profile"))))'
+ linktest='
+(exit (and (string=? (getenv "GUIX_ENVIRONMENT")
+ (string-append (getenv "HOME") "/.guix-profile"))
+ (string-prefix? "'"$NIX_STORE_DIR"'"
+ (readlink (string-append (getenv "HOME")
+ "/.guix-profile")))))'
cd "$tmpdir" \
&& guix environment --bootstrap --container --link-profile \
diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh
index 2faf38df06..f8be48f0c0 100644
--- a/tests/guix-environment.sh
+++ b/tests/guix-environment.sh
@@ -60,7 +60,7 @@ guix environment --bootstrap --ad-hoc guile-bootstrap --pure \
grep '^PATH=' "$tmpdir/a"
grep '^GUIX_TEST_ABC=' "$tmpdir/a"
grep '^GUIX_TEST_DEF=' "$tmpdir/a"
-if grep '^GUIX_TEST_XYZ=' "$tmpdir/a"; then false; else true; fi
+! grep '^GUIX_TEST_XYZ=' "$tmpdir/a"
# Make sure the exit value is preserved.
if guix environment --bootstrap --ad-hoc guile-bootstrap --pure \
@@ -194,8 +194,7 @@ then
done
# 'make-boot0' itself must not be listed.
- if guix gc --references "$profile" | grep make-boot0
- then false; else true; fi
+ ! guix gc --references "$profile" | grep make-boot0
# Make sure that the shell spawned with '--exec' sees the same environment
# as returned by '--search-paths'.
@@ -212,8 +211,7 @@ then
test "x$make_boot0_debug" != "x"
# Make sure the "debug" output is not listed.
- if guix gc --references "$profile" | grep "$make_boot0_debug"
- then false; else true; fi
+ ! guix gc --references "$profile" | grep "$make_boot0_debug"
# Compute the build environment for the initial GNU Make, but add in the
# bootstrap Guile as an ad-hoc addition.
diff --git a/tests/guix-gc.sh b/tests/guix-gc.sh
index 8284287730..f40619876d 100644
--- a/tests/guix-gc.sh
+++ b/tests/guix-gc.sh
@@ -36,11 +36,11 @@ unset out
# For some operations, passing extra arguments is an error.
for option in "" "-C 500M" "--verify" "--optimize" "--list-roots"
do
- if guix gc $option whatever; then false; else true; fi
+ ! guix gc $option whatever
done
# This should fail.
-if guix gc --verify=foo; then false; else true; fi
+! guix gc --verify=foo
# Check the references of a .drv.
drv="`guix build guile-bootstrap -d`"
@@ -51,8 +51,7 @@ guix gc --references "$drv" | grep -e -bash
guix gc --references "$out"
guix gc --references "$out/bin/guile"
-if guix gc --references /dev/null;
-then false; else true; fi
+! guix gc --references /dev/null;
# Check derivers.
guix gc --derivers "$out" | grep "$drv"
@@ -72,8 +71,7 @@ test -f "$drv" && test -L guix-gc-root
guix gc --list-roots | grep "$PWD/guix-gc-root"
guix gc --list-live | grep "$drv"
-if guix gc --delete "$drv";
-then false; else true; fi
+! guix gc --delete "$drv";
rm guix-gc-root
guix gc --list-dead | grep "$drv"
@@ -84,8 +82,7 @@ guix gc --delete "$drv"
guix gc -C 1KiB
# Check trivial error cases.
-if guix gc --delete /dev/null;
-then false; else true; fi
+! guix gc --delete /dev/null;
# Bug #19757
out="`guix build guile-bootstrap`"
diff --git a/tests/guix-git-authenticate.sh b/tests/guix-git-authenticate.sh
index 1c76e240b5..8ebbea398b 100644
--- a/tests/guix-git-authenticate.sh
+++ b/tests/guix-git-authenticate.sh
@@ -46,9 +46,8 @@ v1_0_0_signer="3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5" # civodul
v1_0_1_commit="d68de958b60426798ed62797ff7c96c327a672ac"
# This should fail because these commits lack '.guix-authorizations'.
-if guix git authenticate "$v1_0_0_commit" "$v1_0_0_signer" \
- --cache-key="$cache_key" --end="$v1_0_1_commit";
-then false; else true; fi
+! guix git authenticate "$v1_0_0_commit" "$v1_0_0_signer" \
+ --cache-key="$cache_key" --end="$v1_0_1_commit"
# This should work thanks to '--historical-authorizations'.
guix git authenticate "$v1_0_0_commit" "$v1_0_0_signer" \
diff --git a/tests/guix-graph.sh b/tests/guix-graph.sh
index ccb4933c88..666660ab4b 100644
--- a/tests/guix-graph.sh
+++ b/tests/guix-graph.sh
@@ -60,7 +60,7 @@ guix graph -t references guile-bootstrap | grep guile-bootstrap
guix graph -e '(@ (gnu packages bootstrap) %bootstrap-guile)' \
| grep guile-bootstrap
-if guix graph -e +; then false; else true; fi
+! guix graph -e +
# Try passing store file names.
@@ -77,14 +77,13 @@ cmp "$tmpfile1" "$tmpfile2"
# Try package transformation options.
guix graph git | grep 'label = "openssl'
guix graph git --with-input=openssl=libressl | grep 'label = "libressl'
-if guix graph git --with-input=openssl=libressl | grep 'label = "openssl'
-then false; else true; fi
+! guix graph git --with-input=openssl=libressl | grep 'label = "openssl'
# Try --load-path
guix graph -L $module_dir dummy | grep 'label = "dummy'
# Displaying shortest paths (or lack thereof).
-if guix graph --path emacs vim; then false; else true; fi
+! guix graph --path emacs vim
path="\
emacs
diff --git a/tests/guix-hash.sh b/tests/guix-hash.sh
index 3538b9aeda..346355539f 100644
--- a/tests/guix-hash.sh
+++ b/tests/guix-hash.sh
@@ -34,8 +34,7 @@ test `guix hash -f base32 /dev/null` = 4oymiquy7qobjgx36tejs35zeqt24qpemsnzgtfes
test `guix hash -H sha512 -f hex /dev/null` = cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e
test `guix hash -H sha1 -f base64 /dev/null` = "2jmj7l5rSw0yVb/vlWAYkK/YBwk="
-if guix hash -H abcd1234 /dev/null;
-then false; else true; fi
+! guix hash -H abcd1234 /dev/null
mkdir "$tmpdir"
echo -n executable > "$tmpdir/exe"
@@ -46,13 +45,11 @@ mkdir "$tmpdir/subdir"
test `guix hash -r "$tmpdir"` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
# Without '-r', this should fail.
-if guix hash "$tmpdir"
-then false; else true; fi
+! guix hash "$tmpdir"
# This should fail because /dev/null is a character device, which
# the archive format doesn't support.
-if guix hash -r /dev/null
-then false; else true; fi
+! guix hash -r /dev/null
# Adding a .git directory
mkdir "$tmpdir/.git"
@@ -65,6 +62,5 @@ test `guix hash -r $tmpdir` = 0a50z04zyzf7pidwxv0nwbj82pgzbrhdy9562kncnvkcfvb48m
test `guix hash -r $tmpdir -x` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
# Without '-r', this should fail.
-if guix hash "$tmpdir"
-then false; else true; fi
+! guix hash "$tmpdir"
diff --git a/tests/guix-lint.sh b/tests/guix-lint.sh
index ebe79efb84..fdf548fbf1 100644
--- a/tests/guix-lint.sh
+++ b/tests/guix-lint.sh
@@ -58,24 +58,19 @@ grep_warning ()
# 3) the description has a single space following the end-of-sentence period.
out=`guix lint -c synopsis,description dummy 2>&1`
-if [ `grep_warning "$out"` -ne 3 ]
-then false; else true; fi
+test `grep_warning "$out"` -eq 3
out=`guix lint -c synopsis dummy 2>&1`
-if [ `grep_warning "$out"` -ne 2 ]
-then false; else true; fi
+test `grep_warning "$out"` -eq 2
out=`guix lint -c description dummy 2>&1`
-if [ `grep_warning "$out"` -ne 1 ]
-then false; else true; fi
+test `grep_warning "$out"` -eq 1
out=`guix lint -c description,synopsis dummy 2>&1`
-if [ `grep_warning "$out"` -ne 3 ]
-then false; else true; fi
+test `grep_warning "$out"` -eq 3
-if guix lint -c synopsis,invalid-checker dummy 2>&1 | \
+guix lint -c synopsis,invalid-checker dummy 2>&1 | \
grep -q 'invalid-checker: invalid checker'
-then true; else false; fi
# Make sure specifying multiple packages works.
guix lint -c inputs-should-be-native dummy dummy@42 dummy
@@ -85,8 +80,7 @@ guix lint -c inputs-should-be-native dummy dummy@42 dummy
unset GUIX_PACKAGE_PATH
out=`guix lint -L $module_dir -c synopsis,description dummy 2>&1`
-if [ `grep_warning "$out"` -ne 3 ]
-then false; else true; fi
+test `grep_warning "$out"` -eq 3
# Make sure specifying multiple packages works.
guix lint -L $module_dir -c inputs-should-be-native dummy dummy@42 dummy
diff --git a/tests/guix-pack-relocatable.sh b/tests/guix-pack-relocatable.sh
index b8d36a02c6..a960ecd209 100644
--- a/tests/guix-pack-relocatable.sh
+++ b/tests/guix-pack-relocatable.sh
@@ -77,8 +77,7 @@ then
grep 'GNU sed' "$test_directory/output"
# Check whether the exit code is preserved.
- if run_without_store "$test_directory/Bin/sed" --does-not-exist;
- then false; else true; fi
+ ! run_without_store "$test_directory/Bin/sed" --does-not-exist
chmod -Rf +w "$test_directory"; rm -rf "$test_directory"/*
else
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index 39b64791e2..0339221ac2 100644
--- a/tests/guix-pack.sh
+++ b/tests/guix-pack.sh
@@ -45,8 +45,7 @@ guix gc -R "$drv" | grep "`guix build coreutils -d --no-grafts`"
drv="`guix pack idutils -d --no-grafts --target=arm-linux-gnueabihf`"
guix gc -R "$drv" | \
grep "`guix build idutils --target=arm-linux-gnueabihf -d --no-grafts`"
-if guix gc -R "$drv" | grep "`guix build idutils -d --no-grafts`";
-then false; else true; fi
+! guix gc -R "$drv" | grep "`guix build idutils -d --no-grafts`"
# Build a tarball with no compression.
guix pack --compression=none --bootstrap guile-bootstrap
diff --git a/tests/guix-package-aliases.sh b/tests/guix-package-aliases.sh
index e24bff3a56..311838b768 100644
--- a/tests/guix-package-aliases.sh
+++ b/tests/guix-package-aliases.sh
@@ -36,26 +36,28 @@ guix install --bootstrap guile-bootstrap -p "$profile"
test -x "$profile/bin/guile"
# Make sure '-r' isn't passed as-is to 'guix package'.
-if guix install -r guile-bootstrap -p "$profile" --bootstrap
-then false; else true; fi
+! guix install -r guile-bootstrap -p "$profile" --bootstrap
test -x "$profile/bin/guile"
+# Use a package transformation option and make sure it's recorded.
+guix install --bootstrap guile-bootstrap -p "$profile" \
+ --with-input=libreoffice=inkscape
+test -x "$profile/bin/guile"
+grep "libreoffice=inkscape" "$profile/manifest"
+
guix upgrade --version
guix upgrade -n
guix upgrade gui.e -n
-if guix upgrade foo bar -n;
-then false; else true; fi
+! guix upgrade foo bar -n;
guix remove --version
guix remove --bootstrap guile-bootstrap -p "$profile"
! test -x "$profile/bin/guile"
test `guix package -p "$profile" -I | wc -l` -eq 0
-if guix remove -p "$profile" this-is-not-installed --bootstrap
-then false; else true; fi
+! guix remove -p "$profile" this-is-not-installed --bootstrap
-if guix remove -i guile-bootstrap -p "$profile" --bootstrap
-then false; else true; fi
+! guix remove -i guile-bootstrap -p "$profile" --bootstrap
guix search '\<board\>' game | grep '^name: gnubg'
@@ -64,7 +66,7 @@ guix show guile
guix show python@3 | grep "^name: python"
# "python@2" exists but is deprecated; make sure it doesn't show up.
-if guix show python@2; then false; else true; fi
+! guix show python@2
# Specifying multiple packages.
output="`guix show sed grep | grep ^name:`"
diff --git a/tests/guix-package-net.sh b/tests/guix-package-net.sh
index 3876701fa2..6d21c6cff6 100644
--- a/tests/guix-package-net.sh
+++ b/tests/guix-package-net.sh
@@ -95,10 +95,8 @@ test "`guix package -p "$profile" -l | cut -f1 | grep guile | head -n1`" \
= " guile-bootstrap"
# Exit with 1 when a generation does not exist.
-if guix package -p "$profile" --list-generations=42;
-then false; else true; fi
-if guix package -p "$profile" --switch-generation=99;
-then false; else true; fi
+! guix package -p "$profile" --list-generations=42
+! guix package -p "$profile" --switch-generation=99
# Remove a package.
guix package --bootstrap -p "$profile" -r "guile-bootstrap"
@@ -174,8 +172,7 @@ test -z "`guix package -p "$profile" -l 3`"
rm "$profile"
guix package --bootstrap -p "$profile" -i guile-bootstrap
guix package --bootstrap -p "$profile_alt" -i gcc-bootstrap
-if guix package -p "$profile" --search-paths | grep LIBRARY_PATH
-then false; fi
+! guix package -p "$profile" --search-paths | grep LIBRARY_PATH
guix package -p "$profile" -p "$profile_alt" --search-paths \
| grep "LIBRARY_PATH.*$profile/lib.$profile_alt/lib"
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index 1f955257be..3e5fa71d20 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
#
# This file is part of GNU Guix.
@@ -36,8 +36,7 @@ rm -f "$profile" "$tmpfile"
trap 'rm -f "$profile" "$profile.lock" "$profile-"[0-9]* "$tmpfile"; rm -rf "$module_dir" t-home-'"$$" EXIT
# Use `-e' with a non-package expression.
-if guix package --bootstrap -e +;
-then false; else true; fi
+! guix package --bootstrap -e +
# Install a store item and make sure the version and output in the manifest
# are correct.
@@ -62,8 +61,7 @@ test -f "$profile/bin/guile"
# 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 g-wrap guile@2.0
guix package --bootstrap -n -p "$profile" -i g-wrap guile@2.0 \
--allow-collisions
@@ -78,8 +76,7 @@ test "`guix package -p "$profile" --search-paths | wc -l`" = 1 # $PATH
type -P rm )
# Exit with 1 when a generation does not exist.
-if guix package -p "$profile" --delete-generations=42;
-then false; else true; fi
+! guix package -p "$profile" --delete-generations=42
# Exit with 0 when trying to delete the zeroth generation.
guix package -p "$profile" --delete-generations=0
@@ -92,15 +89,12 @@ guix package --bootstrap -i "glibc:debug" -p "$profile" -n
# Make sure nonexistent outputs are reported.
guix package --bootstrap -i "guile-bootstrap:out" -p "$profile" -n
-if guix package --bootstrap -i "guile-bootstrap:does-not-exist" -p "$profile" -n;
-then false; else true; fi
-if guix package --bootstrap -i "guile-bootstrap:does-not-exist" -p "$profile";
-then false; else true; fi
+! guix package --bootstrap -i "guile-bootstrap:does-not-exist" -p "$profile" -n
+! guix package --bootstrap -i "guile-bootstrap:does-not-exist" -p "$profile"
# Make sure we get an error when trying to remove something that's not
# installed.
-if guix package --bootstrap -r something-not-installed -p "$profile";
-then false; else true; fi
+! guix package --bootstrap -r something-not-installed -p "$profile"
# Check whether `--list-available' returns something sensible.
guix package -p "$profile" -A 'gui.*e' | grep guile
@@ -112,8 +106,8 @@ guix package --show=guile | grep "^name: guile"
guix package --show=texlive
# Fail for non-existent packages or package/version pairs.
-if guix package --show=does-not-exist; then false; else true; fi
-if guix package --show=emacs@42; then false; else true; fi
+! guix package --show=does-not-exist
+! guix package --show=emacs@42
# Search.
LC_MESSAGES=C
@@ -157,22 +151,19 @@ guix package --search="" > /dev/null
# There's no generation older than 12 months, so the following command should
# have no effect.
generation="`readlink_base "$profile"`"
-if guix package -p "$profile" --delete-generations=12m;
-then false; else true; fi
+! guix package -p "$profile" --delete-generations=12m
test "`readlink_base "$profile"`" = "$generation"
# The following command should not delete the current generation, even though
# it matches the given pattern (see <http://bugs.gnu.org/19978>.) And since
# there's nothing else to delete, it should just fail.
guix package --list-generations -p "$profile"
-if guix package --bootstrap -p "$profile" --delete-generations=1..
-then false; else true; fi
+! guix package --bootstrap -p "$profile" --delete-generations=1..
test "`readlink_base "$profile"`" = "$generation"
# Make sure $profile is a GC root at this point.
real_profile="`readlink -f "$profile"`"
-if guix gc -d "$real_profile"
-then false; else true; fi
+! guix gc -d "$real_profile"
test -d "$real_profile"
# Now, let's remove all the symlinks to $real_profile, and make sure
@@ -193,6 +184,21 @@ grep -E 'emacs[[:blank:]]+42\.5\.9rc7' "$tmpfile"
rm "$emacs_tarball" "$tmpfile"
rmdir "$module_dir"
+# Install with package transformations.
+guix install --bootstrap -p "$profile" sed --with-input=sed=guile-bootstrap
+grep "sed=guile-bootstrap" "$profile/manifest"
+test "$(readlink -f "$profile/bin/guile")" \
+ = "$(guix build guile-bootstrap)/bin/guile"
+test ! -f "$profile/bin/sed"
+
+# Make sure the package transformation is preserved.
+guix package --bootstrap -p "$profile" -u
+grep "sed=guile-bootstrap" "$profile/manifest"
+test "$(readlink -f "$profile/bin/guile")" \
+ = "$(guix build guile-bootstrap)/bin/guile"
+test ! -f "$profile/bin/sed"
+rm "$profile" "$profile"-[0-9]-link
+
# Profiles with a relative file name. Make sure we don't create dangling
# symlinks--see bug report at
# <https://lists.gnu.org/archive/html/guix-devel/2018-07/msg00036.html>.
@@ -238,16 +244,15 @@ done
# Check whether '-p ~/.guix-profile' makes any difference.
# See <http://bugs.gnu.org/17939>.
-if test -e "$HOME/.guix-profile-0-link"; then false; fi
-if test -e "$HOME/.guix-profile-1-link"; then false; fi
+! test -e "$HOME/.guix-profile-0-link"
+! test -e "$HOME/.guix-profile-1-link"
guix package --bootstrap -p "$HOME/.guix-profile" -i guile-bootstrap
-if test -e "$HOME/.guix-profile-1-link"; then false; fi
+! test -e "$HOME/.guix-profile-1-link"
guix package --bootstrap --roll-back -p "$HOME/.guix-profile"
-if test -e "$HOME/.guix-profile-0-link"; then false; fi
+! test -e "$HOME/.guix-profile-0-link"
# Extraneous argument.
-if guix package install foo-bar;
-then false; else true; fi
+! guix package install foo-bar
# Make sure the "broken pipe" doesn't yield an error.
# Note: 'pipefail' is a Bash-specific option.
@@ -267,7 +272,7 @@ cat > "$module_dir/foo.scm"<<EOF
(define-public x
(package (inherit emacs)
(name "emacs-foo-bar")
- (version "42")))
+ (version "42.77.0")))
EOF
guix package -A emacs-foo-bar -L "$module_dir" | grep 42
@@ -308,7 +313,7 @@ cat > "$module_dir/foo.scm"<<EOF
(source (origin (inherit (package-source emacs))
(patches (list (search-patch "emacs.patch")))))
(name "emacs-foo-bar-patched")
- (version "42")))
+ (version "42.42.42")))
(define-public y
(package (inherit emacs)
@@ -336,8 +341,7 @@ cat > "$module_dir/package.scm"<<EOF
(define my-package coreutils) ;returns *unspecified*
EOF
-if guix package --bootstrap --install-from-file="$module_dir/package.scm"
-then false; else true; fi
+! guix package --bootstrap --install-from-file="$module_dir/package.scm"
rm "$module_dir/package.scm"
diff --git a/tests/guix-repl.sh b/tests/guix-repl.sh
index e1c2b8241f..d4ebb5f6c6 100644
--- a/tests/guix-repl.sh
+++ b/tests/guix-repl.sh
@@ -45,6 +45,10 @@ EOF
test "`guix repl "$tmpfile"`" = "coreutils"
+# Make sure that the file can also be loaded when passed as a relative file
+# name.
+(cd "$(dirname "$tmpfile")"; test "$(guix repl "$(basename "$tmpfile")")" = "coreutils")
+
cat > "$module_dir/foo.scm"<<EOF
(define-module (foo)
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index 0e22686a34..957479ede0 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -261,8 +261,8 @@ guix system vm "$tmpfile" -d | grep '\.drv$'
drv1="`guix system vm "$tmpfile" -d`"
drv2="`guix system vm "$tmpfile" -d`"
test "$drv1" = "$drv2"
-drv1="`guix system disk-image --file-system-type=iso9660 "$tmpfile" -d`"
-drv2="`guix system disk-image --file-system-type=iso9660 "$tmpfile" -d`"
+drv1="`guix system disk-image -t iso9660 "$tmpfile" -d`"
+drv2="`guix system disk-image -t iso9660 "$tmpfile" -d`"
test "$drv1" = "$drv2"
make_user_config "group-that-does-not-exist" "users"
@@ -297,6 +297,20 @@ EOF
guix system build "$tmpdir/config.scm" -n
(cd "$tmpdir"; guix system build "config.scm" -n)
+# Check that we get a warning when passing 'local-file' a non-literal relative
+# file name.
+cat > "$tmpdir/config.scm" <<EOF
+(use-modules (guix))
+
+(define (bad-local-file file)
+ (local-file file))
+
+(bad-local-file "whatever.scm")
+EOF
+! guix system build "$tmpdir/config.scm" -n
+guix system build "$tmpdir/config.scm" -n 2>&1 | \
+ grep "config\.scm:4:2: warning:.*whatever.*relative to current directory"
+
# Searching.
guix system search tor | grep "^name: tor"
guix system search tor | grep "^shepherdnames: tor"
@@ -320,5 +334,8 @@ guix system -n vm gnu/system/examples/vm-image.tmpl
guix system -n vm-image gnu/system/examples/vm-image.tmpl
# This invocation was taken care of in the loop above:
# guix system -n disk-image gnu/system/examples/bare-bones.tmpl
-guix system -n disk-image --file-system-type=iso9660 gnu/system/examples/bare-bones.tmpl
+guix system -n disk-image -t iso9660 gnu/system/examples/bare-bones.tmpl
guix system -n docker-image gnu/system/examples/docker-image.tmpl
+
+# Verify that at least the raw image type is available.
+guix system --list-image-types | grep "raw"
diff --git a/tests/opam.scm b/tests/opam.scm
index 68b5908e3f..ec2a668307 100644
--- a/tests/opam.scm
+++ b/tests/opam.scm
@@ -116,81 +116,76 @@ url {
;; Test the opam file parser
;; We fold over some test cases. Each case is a pair of the string to parse and the
;; expected result.
-(test-assert "parse-strings"
- (fold (lambda (test acc)
- (display test) (newline)
- (and acc
- (let ((result (peg:tree (match-pattern string-pat (car test)))))
- (if (equal? result (cdr test))
- #t
- (pk 'fail (list (car test) result (cdr test)) #f)))))
- #t '(("" . #f)
- ("\"hello\"" . (string-pat "hello"))
- ("\"hello world\"" . (string-pat "hello world"))
- ("\"The dreaded \\\"é\\\"\"" . (string-pat "The dreaded \"é\""))
- ("\"Have some \\\\\\\\ :)\"" . (string-pat "Have some \\\\ :)"))
- ("\"今日は\"" . (string-pat "今日は")))))
+(define (test-opam-syntax name pattern test-cases)
+ (test-assert name
+ (fold (lambda (test acc)
+ (display test) (newline)
+ (match test
+ ((str . expected)
+ (and acc
+ (let ((result (peg:tree (match-pattern pattern str))))
+ (if (equal? result expected)
+ #t
+ (pk 'fail (list str result expected) #f)))))))
+ #t test-cases)))
-(test-assert "parse-multiline-strings"
- (fold (lambda (test acc)
- (display test) (newline)
- (and acc
- (let ((result (peg:tree (match-pattern multiline-string (car test)))))
- (if (equal? result (cdr test))
- #t
- (pk 'fail (list (car test) result (cdr test)) #f)))))
- #t '(("" . #f)
- ("\"\"\"hello\"\"\"" . (multiline-string "hello"))
- ("\"\"\"hello \"world\"!\"\"\"" . (multiline-string "hello \"world\"!"))
- ("\"\"\"hello \"\"world\"\"!\"\"\"" . (multiline-string "hello \"\"world\"\"!")))))
+(test-opam-syntax
+ "parse-strings" string-pat
+ '(("" . #f)
+ ("\"hello\"" . (string-pat "hello"))
+ ("\"hello world\"" . (string-pat "hello world"))
+ ("\"The dreaded \\\"é\\\"\"" . (string-pat "The dreaded \"é\""))
+ ("\"Have some \\\\\\\\ :)\"" . (string-pat "Have some \\\\ :)"))
+ ("\"今日は\"" . (string-pat "今日は"))))
-(test-assert "parse-lists"
- (fold (lambda (test acc)
- (and acc
- (let ((result (peg:tree (match-pattern list-pat (car test)))))
- (if (equal? result (cdr test))
- #t
- (pk 'fail (list (car test) result (cdr test)) #f)))))
- #t '(("" . #f)
- ("[]" . list-pat)
- ("[make]" . (list-pat (var "make")))
- ("[\"make\"]" . (list-pat (string-pat "make")))
- ("[\n a\n b\n c]" . (list-pat (var "a") (var "b") (var "c")))
- ("[a b \"c\"]" . (list-pat (var "a") (var "b") (string-pat "c"))))))
+(test-opam-syntax
+ "parse-multiline-strings" multiline-string
+ '(("" . #f)
+ ("\"\"\"hello\"\"\"" . (multiline-string "hello"))
+ ("\"\"\"hello \"world\"!\"\"\"" . (multiline-string "hello \"world\"!"))
+ ("\"\"\"hello \"\"world\"\"!\"\"\"" . (multiline-string "hello \"\"world\"\"!"))))
-(test-assert "parse-dicts"
- (fold (lambda (test acc)
- (and acc
- (let ((result (peg:tree (match-pattern dict (car test)))))
- (if (equal? result (cdr test))
- #t
- (pk 'fail (list (car test) result (cdr test)) #f)))))
- #t '(("" . #f)
- ("{}" . dict)
- ("{a: \"b\"}" . (dict (record "a" (string-pat "b"))))
- ("{a: \"b\"\nc: \"d\"}" . (dict (record "a" (string-pat "b")) (record "c" (string-pat "d")))))))
+(test-opam-syntax
+ "parse-lists" list-pat
+ '(("" . #f)
+ ("[]" . list-pat)
+ ("[make]" . (list-pat (var "make")))
+ ("[\"make\"]" . (list-pat (string-pat "make")))
+ ("[\n a\n b\n c]" . (list-pat (var "a") (var "b") (var "c")))
+ ("[a b \"c\"]" . (list-pat (var "a") (var "b") (string-pat "c")))
+ ;; complex lists
+ ("[(a & b)]" . (list-pat (choice-pat (group-pat (var "a") (var "b")))))
+ ("[(a | b & c)]" . (list-pat (choice-pat (var "a") (group-pat (var "b") (var "c")))))
+ ("[a (b | c) d]" . (list-pat (var "a") (choice-pat (var "b") (var "c")) (var "d")))))
-(test-assert "parse-conditions"
- (fold (lambda (test acc)
- (and acc
- (let ((result (peg:tree (match-pattern condition (car test)))))
- (if (equal? result (cdr test))
- #t
- (pk 'fail (list (car test) result (cdr test)) #f)))))
- #t '(("" . #f)
- ("{}" . #f)
- ("{build}" . (condition-var "build"))
- ("{>= \"0.2.0\"}" . (condition-greater-or-equal
- (condition-string "0.2.0")))
- ("{>= \"0.2.0\" & test}" . (condition-and
- (condition-greater-or-equal
- (condition-string "0.2.0"))
- (condition-var "test")))
- ("{>= \"0.2.0\" | build}" . (condition-or
- (condition-greater-or-equal
- (condition-string "0.2.0"))
- (condition-var "build")))
- ("{ = \"1.0+beta19\" }" . (condition-eq
- (condition-string "1.0+beta19"))))))
+(test-opam-syntax
+ "parse-dicts" dict
+ '(("" . #f)
+ ("{}" . dict)
+ ("{a: \"b\"}" . (dict (record "a" (string-pat "b"))))
+ ("{a: \"b\"\nc: \"d\"}" . (dict (record "a" (string-pat "b")) (record "c" (string-pat "d"))))))
+
+(test-opam-syntax
+ "parse-conditions" condition
+ '(("" . #f)
+ ("{}" . #f)
+ ("{build}" . (condition-var "build"))
+ ("{>= \"0.2.0\"}" . (condition-greater-or-equal
+ (condition-string "0.2.0")))
+ ("{>= \"0.2.0\" & test}" . (condition-and
+ (condition-greater-or-equal
+ (condition-string "0.2.0"))
+ (condition-var "test")))
+ ("{>= \"0.2.0\" | build}" . (condition-or
+ (condition-greater-or-equal
+ (condition-string "0.2.0"))
+ (condition-var "build")))
+ ("{ = \"1.0+beta19\" }" . (condition-eq
+ (condition-string "1.0+beta19")))))
+
+(test-opam-syntax
+ "parse-comment" list-pat
+ '(("" . #f)
+ ("[#comment\n]" . list-pat)))
(test-end "opam")
diff --git a/tests/openpgp.scm b/tests/openpgp.scm
index 0beab6f88b..c2be26fa49 100644
--- a/tests/openpgp.scm
+++ b/tests/openpgp.scm
@@ -50,6 +50,12 @@ vBSFjNSiVHsuAA==
=AAAA
-----END PGP MESSAGE-----\n")
+(define %binary-sample
+ ;; Same message as %radix-64-sample, decoded into bytevector.
+ (base16-string->bytevector
+ "c838013b6d96c411efecef17ecefe3ca0004ce8979ea250a897995f979a9\
+0ad9a9a9050a890ac5a9c945a940c1a2fcd2bc14858cd4a2547b2e00"))
+
(define %civodul-fingerprint
"3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5")
@@ -155,6 +161,12 @@ Pz7oopeN72xgggYUNT37ezqN3MeCqw0=
read-radix-64))
list))
+(test-assert "port-ascii-armored?, #t"
+ (call-with-input-string %radix-64-sample port-ascii-armored?))
+
+(test-assert "port-ascii-armored?, #f"
+ (not (port-ascii-armored? (open-bytevector-input-port %binary-sample))))
+
(test-assert "get-openpgp-keyring"
(let* ((key (search-path %load-path "tests/civodul.key"))
(keyring (get-openpgp-keyring
diff --git a/tests/packages.scm b/tests/packages.scm
index cbd0503733..5d5abcbd76 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -38,6 +38,7 @@
#:use-module (guix build-system)
#:use-module (guix build-system trivial)
#:use-module (guix build-system gnu)
+ #:use-module (guix build-system python)
#:use-module (guix memoization)
#:use-module (guix profiles)
#:use-module (guix scripts package)
@@ -45,6 +46,7 @@
#:use-module (gnu packages base)
#:use-module (gnu packages guile)
#:use-module (gnu packages bootstrap)
+ #:use-module (gnu packages python)
#:use-module (gnu packages version-control)
#:use-module (gnu packages xml)
#:use-module (srfi srfi-1)
@@ -185,6 +187,29 @@
(string=? (manifest-pattern-version pattern) "1")
(string=? (manifest-pattern-output pattern) "out")))))))
+(test-equal "transaction-upgrade-entry, transformation options preserved"
+ (derivation-file-name (package-derivation %store grep))
+
+ (let* ((old (dummy-package "emacs" (version "1")))
+ (props '((transformations . ((with-input . "emacs=grep")))))
+ (tx (transaction-upgrade-entry
+ %store
+ (manifest-entry
+ (inherit (package->manifest-entry old))
+ (properties props)
+ (item (string-append (%store-prefix) "/"
+ (make-string 32 #\e) "-foo-1")))
+ (manifest-transaction))))
+ (match (manifest-transaction-install tx)
+ (((? manifest-entry? entry))
+ (and (string=? (manifest-entry-version entry)
+ (package-version grep))
+ (string=? (manifest-entry-name entry)
+ (package-name grep))
+ (equal? (manifest-entry-properties entry) props)
+ (derivation-file-name
+ (package-derivation %store (manifest-entry-item entry))))))))
+
(test-assert "transaction-upgrade-entry, grafts"
;; Ensure that, when grafts are enabled, 'transaction-upgrade-entry' doesn't
;; try to build stuff.
@@ -1172,15 +1197,24 @@
(let* ((dep (dummy-package "chbouib"
(native-inputs `(("x" ,grep)))))
(p0 (dummy-package "example"
+ (source 77)
(inputs `(("foo" ,coreutils)
("bar" ,grep)
("baz" ,dep)))))
(transform (lambda (p)
(package (inherit p) (source 42))))
(rewrite (package-mapping transform))
- (p1 (rewrite p0)))
+ (p1 (rewrite p0))
+ (bag0 (package->bag p0))
+ (bag1 (package->bag p1)))
(and (eq? p1 (rewrite p0))
(eqv? 42 (package-source p1))
+
+ ;; Implicit inputs should be left unchanged (skip "source", "foo",
+ ;; "bar", and "baz" in this comparison).
+ (equal? (drop (bag-direct-inputs bag0) 4)
+ (drop (bag-direct-inputs bag1) 4))
+
(match (package-inputs p1)
((("foo" dep1) ("bar" dep2) ("baz" dep3))
(and (eq? dep1 (rewrite coreutils)) ;memoization
@@ -1194,6 +1228,31 @@
(and (eq? dep (rewrite grep))
(package-source dep))))))))))
+(test-equal "package-mapping, deep"
+ '(42)
+ (let* ((p0 (dummy-package "example"
+ (inputs `(("foo" ,coreutils)
+ ("bar" ,grep)))))
+ (transform (lambda (p)
+ (package (inherit p) (source 42))))
+ (rewrite (package-mapping transform #:deep? #t))
+ (p1 (rewrite p0))
+ (bag (package->bag p1)))
+ (and (eq? p1 (rewrite p0))
+ (match (bag-direct-inputs bag)
+ ((("source" 42) ("foo" dep1) ("bar" dep2) rest ..1)
+ (and (eq? dep1 (rewrite coreutils)) ;memoization
+ (eq? dep2 (rewrite grep))
+ (= 42 (package-source dep1))
+ (= 42 (package-source dep2))
+
+ ;; Check that implicit inputs of P0 also got rewritten.
+ (delete-duplicates
+ (map (match-lambda
+ ((_ package . _)
+ (package-source package)))
+ rest))))))))
+
(test-assert "package-input-rewriting"
(let* ((dep (dummy-package "chbouib"
(native-inputs `(("x" ,grep)))))
@@ -1203,7 +1262,8 @@
("baz" ,dep)))))
(rewrite (package-input-rewriting `((,coreutils . ,sed)
(,grep . ,findutils))
- (cut string-append "r-" <>)))
+ (cut string-append "r-" <>)
+ #:deep? #f))
(p1 (rewrite p0))
(p2 (rewrite p0)))
(and (not (eq? p1 p0))
@@ -1217,7 +1277,22 @@
(eq? dep3 (rewrite dep)) ;memoization
(match (package-native-inputs dep3)
((("x" dep))
- (eq? dep findutils)))))))))
+ (eq? dep findutils))))))
+
+ ;; Make sure implicit inputs were left unchanged.
+ (equal? (drop (bag-direct-inputs (package->bag p1)) 3)
+ (drop (bag-direct-inputs (package->bag p0)) 3)))))
+
+(test-eq "package-input-rewriting, deep"
+ (derivation-file-name (package-derivation %store sed))
+ (let* ((p0 (dummy-package "chbouib"
+ (build-system python-build-system)
+ (arguments `(#:python ,python))))
+ (rewrite (package-input-rewriting `((,python . ,sed))))
+ (p1 (rewrite p0)))
+ (match (bag-direct-inputs (package->bag p1))
+ ((("python" python) _ ...)
+ (derivation-file-name (package-derivation %store python))))))
(test-assert "package-input-rewriting/spec"
(let* ((dep (dummy-package "chbouib"
@@ -1228,7 +1303,8 @@
("baz" ,dep)))))
(rewrite (package-input-rewriting/spec
`(("coreutils" . ,(const sed))
- ("grep" . ,(const findutils)))))
+ ("grep" . ,(const findutils)))
+ #:deep? #f))
(p1 (rewrite p0))
(p2 (rewrite p0)))
(and (not (eq? p1 p0))
@@ -1245,7 +1321,11 @@
(match (package-native-inputs dep3)
((("x" dep))
(string=? (package-full-name dep)
- (package-full-name findutils))))))))))
+ (package-full-name findutils)))))))
+
+ ;; Make sure implicit inputs were left unchanged.
+ (equal? (drop (bag-direct-inputs (package->bag p1)) 3)
+ (drop (bag-direct-inputs (package->bag p0)) 3)))))
(test-assert "package-input-rewriting/spec, partial match"
(let* ((dep (dummy-package "chbouib"
@@ -1256,7 +1336,8 @@
("bar" ,dep)))))
(rewrite (package-input-rewriting/spec
`(("chbouib@123" . ,(const sed)) ;not matched
- ("grep" . ,(const findutils)))))
+ ("grep" . ,(const findutils)))
+ #:deep? #f))
(p1 (rewrite p0)))
(and (not (eq? p1 p0))
(string=? "example" (package-name p1))
@@ -1270,6 +1351,85 @@
(string=? (package-full-name dep)
(package-full-name findutils))))))))))
+(test-assert "package-input-rewriting/spec, deep"
+ (let* ((dep (dummy-package "chbouib"))
+ (p0 (dummy-package "example"
+ (build-system gnu-build-system)
+ (inputs `(("dep" ,dep)))))
+ (rewrite (package-input-rewriting/spec
+ `(("tar" . ,(const sed))
+ ("gzip" . ,(const findutils)))))
+ (p1 (rewrite p0))
+ (p2 (rewrite p0)))
+ (and (not (eq? p1 p0))
+ (eq? p1 p2) ;memoization
+ (string=? "example" (package-name p1))
+ (match (package-inputs p1)
+ ((("dep" dep1))
+ (and (string=? (package-full-name dep1)
+ (package-full-name dep))
+ (eq? dep1 (rewrite dep))))) ;memoization
+
+ ;; Make sure implicit inputs were replaced.
+ (match (bag-direct-inputs (package->bag p1))
+ ((("dep" dep1) ("tar" tar) ("gzip" gzip) _ ...)
+ (and (eq? dep1 (rewrite dep))
+ (string=? (package-full-name tar)
+ (package-full-name sed))
+ (string=? (package-full-name gzip)
+ (package-full-name findutils))))))))
+
+(test-assert "package-input-rewriting/spec, no duplicates"
+ ;; Ensure that deep input rewriting does not forget implicit inputs. Doing
+ ;; so could lead to duplicates in a package's inputs: in the example below,
+ ;; P0's transitive inputs would contain one rewritten "python" and one
+ ;; original "python". These two "python" packages are thus not 'eq?' but
+ ;; they lower to the same derivation. See <https://bugs.gnu.org/42156>,
+ ;; which can be reproduced by passing #:deep? #f.
+ (let* ((dep0 (dummy-package "dep0"
+ (build-system trivial-build-system)
+ (propagated-inputs `(("python" ,python)))))
+ (p0 (dummy-package "chbouib"
+ (build-system python-build-system)
+ (arguments `(#:python ,python))
+ (inputs `(("dep0" ,dep0)))))
+ (rewrite (package-input-rewriting/spec '() #:deep? #t))
+ (p1 (rewrite p0))
+ (bag1 (package->bag p1))
+ (pythons (filter-map (match-lambda
+ (("python" python) python)
+ (_ #f))
+ (bag-transitive-inputs bag1))))
+ (match (delete-duplicates pythons eq?)
+ ((p) (eq? p (rewrite python))))))
+
+(test-equal "package-input-rewriting/spec, graft"
+ (derivation-file-name (package-derivation %store sed))
+
+ ;; Make sure replacements are rewritten.
+ (let* ((dep0 (dummy-package "dep"
+ (version "1")
+ (build-system trivial-build-system)
+ (inputs `(("coreutils" ,coreutils)))))
+ (dep1 (dummy-package "dep"
+ (version "0")
+ (build-system trivial-build-system)
+ (replacement dep0)))
+ (p0 (dummy-package "p"
+ (build-system trivial-build-system)
+ (inputs `(("dep" ,dep1)))))
+ (rewrite (package-input-rewriting/spec
+ `(("coreutils" . ,(const sed)))))
+ (p1 (rewrite p0)))
+ (match (package-inputs p1)
+ ((("dep" dep))
+ (match (package-inputs (package-replacement dep))
+ ((("coreutils" coreutils))
+ ;; COREUTILS is not 'eq?' to SED, so the most reliable way to check
+ ;; for equality is to lower to a derivation.
+ (derivation-file-name
+ (package-derivation %store coreutils))))))))
+
(test-equal "package-patched-vulnerabilities"
'(("CVE-2015-1234")
("CVE-2016-1234" "CVE-2018-4567")
diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm
index 32876e956a..5f91360953 100644
--- a/tests/scripts-build.scm
+++ b/tests/scripts-build.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -19,6 +19,7 @@
(define-module (test-scripts-build)
#:use-module (guix tests)
#:use-module (guix store)
+ #:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (guix git-download)
#:use-module (guix scripts build)
@@ -163,11 +164,16 @@
((("foo" dep1) ("bar" dep2))
(and (string=? (package-full-name dep1)
(package-full-name grep))
- (eq? (package-replacement dep1) findutils)
+ (string=? (package-full-name (package-replacement dep1))
+ (package-full-name findutils))
(string=? (package-name dep2) "chbouib")
(match (package-native-inputs dep2)
((("x" dep))
- (eq? (package-replacement dep) findutils)))))))))))
+ (with-store store
+ (string=? (derivation-file-name
+ (package-derivation store findutils))
+ (derivation-file-name
+ (package-derivation store dep))))))))))))))
(test-equal "options->transformation, with-branch"
(git-checkout (url "https://example.org")
@@ -264,5 +270,19 @@
((("x" dep3))
(map package-source (list dep1 dep3))))))))))))
+(test-assert "options->transformation, without-tests"
+ (let* ((dep (dummy-package "dep"))
+ (p (dummy-package "foo"
+ (inputs `(("dep" ,dep)))))
+ (t (options->transformation '((without-tests . "dep")
+ (without-tests . "tar")))))
+ (with-store store
+ (let ((new (t store p)))
+ (match (bag-direct-inputs (package->bag new))
+ ((("dep" dep) ("tar" tar) _ ...)
+ ;; TODO: Check whether TAR has #:tests? #f when transformations
+ ;; apply to implicit inputs.
+ (equal? (package-arguments dep)
+ '(#:tests? #f))))))))
(test-end)
diff --git a/tests/store.scm b/tests/store.scm
index 8ff76e8f98..38051bf5e5 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -223,30 +223,22 @@
;;(> freed 0)
(not (file-exists? p))))))
-(test-assert "add-text-to-store vs. delete-paths"
- ;; Before, 'add-text-to-store' would return PATH2 without noticing that it
- ;; is no longer valid.
+(test-assert "add-text-to-store/add-to-store vs. delete-paths"
+ ;; Before, 'add-text-to-store' and 'add-to-store' would return the same
+ ;; store item without noticing that it is no longer valid.
(with-store store
(let* ((text (random-text))
- (path (add-text-to-store store "delete-me" text))
- (deleted (delete-paths store (list path)))
- (path2 (add-text-to-store store "delete-me" text)))
- (and (string=? path path2)
- (equal? deleted (list path))
- (valid-path? store path)
- (file-exists? path)))))
-
-(test-assert "add-to-store vs. delete-paths"
- ;; Same as above.
- (with-store store
- (let* ((file (search-path %load-path "guix.scm"))
- (path (add-to-store store "delete-me" #t "sha256" file))
- (deleted (delete-paths store (list path)))
- (path2 (add-to-store store "delete-me" #t "sha256" file)))
- (and (string=? path path2)
- (equal? deleted (list path))
- (valid-path? store path)
- (file-exists? path)))))
+ (file (search-path %load-path "guix.scm"))
+ (path1 (add-text-to-store store "delete-me" text))
+ (path2 (add-to-store store "delete-me" #t "sha256" file))
+ (deleted (delete-paths store (list path1 path2))))
+ (and (string=? path1 (add-text-to-store store "delete-me" text))
+ (string=? path2 (add-to-store store "delete-me" #t "sha256" file))
+ (lset= string=? deleted (list path1 path2))
+ (valid-path? store path1)
+ (valid-path? store path2)
+ (file-exists? path1)
+ (file-exists? path2)))))
(test-equal "add-file-tree-to-store"
`(42
@@ -990,7 +982,7 @@
;; Ensure 'import-paths' raises an exception.
(guard (c ((store-protocol-error? c)
- (and (not (zero? (store-protocol-error-status (pk 'C c))))
+ (and (not (zero? (store-protocol-error-status c)))
(string-contains (store-protocol-error-message c)
"lacks a signature"))))
(let* ((source (open-bytevector-input-port dump))
@@ -1030,9 +1022,9 @@
;; Ensure 'import-paths' raises an exception.
(guard (c ((store-protocol-error? c)
- ;; XXX: The daemon-provided error message currently doesn't
- ;; mention the reason of the failure.
- (not (zero? (store-protocol-error-status c)))))
+ (and (not (zero? (store-protocol-error-status c)))
+ (string-contains (store-protocol-error-message c)
+ "unauthorized public key"))))
(let* ((source (open-bytevector-input-port dump))
(imported (import-paths %store source)))
(pk 'unauthorized-imported imported)
generated by cgit v1.2.3 (git 2.46.2) at 2024-11-15 18:14:52 +0000